Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch rfe-854941 Excluding Merge-Ins
This is equivalent to a diff from e784d77fd7 to 27a138ecb3
2021-04-30
| ||
11:10 | TIP #596: Stubs support for Embedding Tcl in other applications check-in: 8a5f4d238e user: jan.nijtmans tags: trunk, main | |
2021-04-28
| ||
15:10 | Fix documentation and remove unused function signature (leftover from earlier implementation) Closed-Leaf check-in: 27a138ecb3 user: jan.nijtmans tags: rfe-854941, tip-596 | |
14:52 | Merge 9.0 check-in: 5623546e4a user: jan.nijtmans tags: rfe-854941, tip-596 | |
2020-10-30
| ||
14:09 | Rename "trunk" to "main", but with new propagating tag "trunk" check-in: 40014cd0fa user: jan.nijtmans tags: trunk, main | |
2020-10-29
| ||
21:09 | merge trunk check-in: b5e7f9da2b user: dgp tags: dgp-refactor | |
21:09 | merge trunk check-in: 9ef0a76b94 user: dgp tags: dgp-properbytearray | |
21:08 | merge trunk check-in: af4787a970 user: dgp tags: novem | |
11:40 | Merge 8.7 Closed-Leaf check-in: e784d77fd7 user: jan.nijtmans tags: trunk | |
11:18 | Merge 8.6 check-in: 642317cdbc user: jan.nijtmans tags: core-8-branch | |
2020-10-27
| ||
21:36 | merge 8.7 check-in: de3076b8ab user: dgp tags: trunk | |
Changes to .fossil-settings/crlf-glob.
1 2 3 4 5 6 7 8 9 | compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs compat/zlib/contrib/vstudio/readme.txt compat/zlib/contrib/vstudio/*/zlib.rc compat/zlib/contrib/vstudio/*/*.sln compat/zlib/win32/*.txt compat/zlib/win64/*.txt libtommath/*.dsp libtommath/*.sln libtommath/*.vcproj | < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs compat/zlib/contrib/vstudio/readme.txt compat/zlib/contrib/vstudio/*/zlib.rc compat/zlib/contrib/vstudio/*/*.sln compat/zlib/win32/*.txt compat/zlib/win64/*.txt libtommath/*.dsp libtommath/*.sln libtommath/*.vcproj tools/tcl.wse.in win/buildall.vc.bat win/coffbase.txt win/makefile.vc win/rules.vc win/rules-ext.vc win/targets.vc win/tcl.dsp win/tcl.dsw |
Changes to .fossil-settings/encoding-glob.
|
| < < | 1 2 3 4 5 6 7 | tools/tcl.wse.in win/buildall.vc.bat win/coffbase.txt win/makefile.vc win/rules.vc win/tcl.dsp win/tcl.dsw |
Added .github/workflows/linux-build.yml.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | name: Linux on: [push] jobs: gcc: runs-on: ubuntu-20.04 strategy: matrix: cfgopt: - "" - "CFLAGS=-DTCL_NO_DEPRECATED=1" - "CFLAGS=-DTCL_UTF_MAX=3" - "--disable-shared" - "--enable-symbols" - "--enable-symbols=mem" defaults: run: shell: bash working-directory: unix steps: - name: Checkout uses: actions/checkout@v2 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c tclOOScript.h working-directory: generic - name: Configure ${{ matrix.cfgopt }} run: | mkdir "${HOME}/install dir" ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) env: CFGOPT: ${{ matrix.cfgopt }} - name: Build run: | make all - name: Build Test Harness run: | make tcltest - name: Run Tests run: | make test env: ERROR_ON_FAILURES: 1 - name: Test-Drive Installation run: | make install - name: Create Distribution Package run: | make dist - name: Convert Documentation to HTML run: | make html-tcl |
Added .github/workflows/mac-build.yml.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | name: macOS on: [push] jobs: xcode: runs-on: macos-11.0 defaults: run: shell: bash working-directory: macosx steps: - name: Checkout uses: actions/checkout@v2 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c tclOOScript.h working-directory: generic - name: Build run: make all env: 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.0 strategy: matrix: cfgopt: - "" - "--disable-shared" - "--enable-symbols" - "--enable-symbols=mem" defaults: run: shell: bash working-directory: unix steps: - 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 }} # Note that macOS is always a 64 bit platform run: ./configure --enable-64bit --enable-dtrace --enable-framework ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1) env: CFLAGS: -arch x86_64 -arch arm64e CFGOPT: ${{ matrix.cfgopt }} - name: Build run: | make all tcltest env: CFLAGS: -arch x86_64 -arch arm64e - name: Run Tests run: | make test env: ERROR_ON_FAILURES: 1 MAC_CI: 1 |
Added .github/workflows/onefiledist.yml.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | name: Build Binaries on: [push] jobs: linux: name: Linux runs-on: ubuntu-16.04 defaults: run: shell: bash steps: - name: Checkout uses: actions/checkout@v2 - name: Prepare run: | touch generic/tclStubInit.c generic/tclOOStubInit.c mkdir 1dist echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV working-directory: . - name: Configure run: ./configure --disable-symbols --disable-shared --enable-zipfs working-directory: unix - name: Build 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}_unofficial chmod +x tclsh${TCL_PATCHLEVEL}_unofficial tar -cf tclsh${TCL_PATCHLEVEL}_unofficial.tar tclsh${TCL_PATCHLEVEL}_unofficial working-directory: 1dist - name: Upload uses: actions/upload-artifact@v2 with: name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (unofficial) path: 1dist/*.tar macos: name: macOS runs-on: macos-11.0 defaults: run: shell: bash steps: - name: Checkout uses: actions/checkout@v2 - name: Checkout create-dmg uses: actions/checkout@v2 with: repository: create-dmg/create-dmg ref: v1.0.8 path: create-dmg - name: Prepare run: | mkdir 1dist touch generic/tclStubInit.c generic/tclOOStubInit.c || true wget https://github.com/culler/macher/releases/download/v1.3/macher sudo cp macher /usr/local/bin sudo chmod a+x /usr/local/bin/macher echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV echo "CREATE_DMG=$(cd create-dmg;pwd)/create-dmg" >> $GITHUB_ENV echo "CFLAGS=-arch x86_64 -arch arm64e" >> $GITHUB_ENV - name: Configure run: ./configure --disable-symbols --disable-shared --enable-zipfs working-directory: unix - name: Build run: | make tclsh 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}_unofficial chmod +x contents/tclsh${TCL_PATCHLEVEL}_unofficial 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}_unofficial to mark the executable as runnable on your machine. EOF $CREATE_DMG \ --volname "Tcl $TCL_PATCHLEVEL (unofficial)" \ --window-pos 200 120 \ --window-size 800 400 \ "Tcl-$TCL_PATCHLEVEL-(unofficial).dmg" \ "contents/" working-directory: 1dist - name: Upload uses: actions/upload-artifact@v2 with: name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (unofficial) path: 1dist/*.dmg win: name: Windows runs-on: windows-latest defaults: run: shell: bash steps: - name: Checkout uses: actions/checkout@v2 - name: Install MSYS2 uses: msys2/setup-msys2@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 --disable-symbols --disable-shared --enable-zipfs 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}_unofficial.exe working-directory: 1dist - name: Upload uses: actions/upload-artifact@v2 with: name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (unofficial) path: '1dist/*_unofficial.exe' |
Added .github/workflows/win-build.yml.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | name: Windows on: [push] jobs: msvc: runs-on: windows-latest defaults: run: shell: powershell working-directory: win strategy: matrix: cfgopt: - "" - "CHECKS=nodep" - "OPTS=static" - "OPTS=symbols" - "OPTS=memdbg" # Using powershell means we need to explicitly stop on failure steps: - name: Checkout uses: actions/checkout@v2 - name: Init MSVC uses: ilammy/msvc-dev-cmd@v1 - name: Build ${{ matrix.cfgopt }} run: | &nmake -f makefile.vc ${{ matrix.cfgopt }} all if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } - name: Build Test Harness ${{ matrix.cfgopt }} run: | &nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } - name: Run Tests ${{ matrix.cfgopt }} run: | &nmake -f makefile.vc ${{ matrix.cfgopt }} test if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } env: ERROR_ON_FAILURES: 1 CI_BUILD_WITH_MSVC: 1 gcc: runs-on: windows-latest defaults: run: shell: bash working-directory: win strategy: matrix: cfgopt: - "" - "CFLAGS=-DTCL_NO_DEPRECATED=1" - "--disable-shared" - "--enable-symbols" - "--enable-symbols=mem" # Using powershell means we need to explicitly stop on failure steps: - name: Checkout uses: actions/checkout@v2 - name: Install MSYS2 and Make run: choco install msys2 make - 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 env: ERROR_ON_FAILURES: 1 # 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 .travis.yml.
︙ | ︙ | |||
51 52 53 54 55 56 57 | - name: "Linux/GCC/Mem-Debug" os: linux dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT="--enable-symbols=mem" | < < < < < < < < | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | - name: "Linux/GCC/Mem-Debug" os: linux dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT="--enable-symbols=mem" # Newer/Older versions of GCC - name: "Linux/GCC 10/Shared" os: linux dist: focal compiler: gcc-10 addons: apt: |
︙ | ︙ | |||
136 137 138 139 140 141 142 | - BUILD_DIR=macosx install: [] script: *mactest addons: homebrew: packages: - libtommath | < < < < < < < < | 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | - BUILD_DIR=macosx install: [] script: *mactest addons: homebrew: packages: - libtommath # Newer MacOS versions - name: "macOS/Clang/Xcode 12/Universal Apps/Shared" os: osx osx_image: xcode12u env: - BUILD_DIR=macosx install: [] |
︙ | ︙ | |||
213 214 215 216 217 218 219 | - name: "Windows/MSVC/Shared" os: windows compiler: cl env: &vcenv - BUILD_DIR=win - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" before_install: &vcpreinst | < | | | | | 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 | - name: "Windows/MSVC/Shared" os: windows compiler: cl env: &vcenv - BUILD_DIR=win - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" before_install: &vcpreinst - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h - PATH="$PATH:$VCDIR" - cd ${BUILD_DIR} install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test - name: "Windows/MSVC/Shared: NO_DEPRECATED" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc test - name: "Windows/MSVC/Static" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static' '-f' makefile.vc test - name: "Windows/MSVC/Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: |
︙ | ︙ | |||
274 275 276 277 278 279 280 | - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: | | | | | | 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 | - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc test - name: "Windows/MSVC-x86/Static" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static' '-f' makefile.vc test - name: "Windows/MSVC-x86/Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: |
︙ | ︙ | |||
311 312 313 314 315 316 317 | - name: "Windows/GCC/Shared" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit" before_install: &makepreinst | < < < < < < < < < < | 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 | - name: "Windows/GCC/Shared" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit" before_install: &makepreinst - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h - choco install -y make zip - cd ${BUILD_DIR} - name: "Windows/GCC/Shared: UTF_MAX=3" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3" before_install: *makepreinst - name: "Windows/GCC/Shared: NO_DEPRECATED" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" before_install: *makepreinst - name: "Windows/GCC/Static" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit --disable-shared" before_install: *makepreinst |
︙ | ︙ | |||
380 381 382 383 384 385 386 | - name: "Windows/GCC-x86/Shared: NO_DEPRECATED" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" before_install: *makepreinst | < < < < < < < < < | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 | - name: "Windows/GCC-x86/Shared: NO_DEPRECATED" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" before_install: *makepreinst - name: "Windows/GCC-x86/Static" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--disable-shared" before_install: *makepreinst |
︙ | ︙ | |||
420 421 422 423 424 425 426 | dist: focal compiler: gcc env: - BUILD_DIR=unix script: - make dist before_install: | < | 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 | dist: focal compiler: gcc env: - BUILD_DIR=unix script: - make dist before_install: - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h - cd ${BUILD_DIR} install: - mkdir "$HOME/install dir" - ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) before_script: - export ERROR_ON_FAILURES=1 script: - make all tcltest || echo "Something wrong, maybe a hickup, let's try again" - make test - make install |
Changes to README.md.
1 2 3 4 5 6 7 | # README: Tcl This is the **Tcl 9.0a2** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). | > > > > > > > > > > > | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | # README: Tcl This is the **Tcl 9.0a2** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). 8.6 (production release, daily build) [![Build Status](https://github.com/tcltk/tcl/workflows/Linux/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Acore-8-6-branch) [![Build Status](https://github.com/tcltk/tcl/workflows/Windows/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Acore-8-6-branch) [![Build Status](https://github.com/tcltk/tcl/workflows/macOS/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Acore-8-6-branch) <br> 8.7 (in development, daily build)) [![Build Status](https://github.com/tcltk/tcl/workflows/Linux/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Acore-8-branch) [![Build Status](https://github.com/tcltk/tcl/workflows/Windows/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Acore-8-branch) [![Build Status](https://github.com/tcltk/tcl/workflows/macOS/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Acore-8-branch) <br> 9.0 (in development, daily build)) [![Build Status](https://github.com/tcltk/tcl/workflows/Linux/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Amain) [![Build Status](https://github.com/tcltk/tcl/workflows/Windows/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Amain) [![Build Status](https://github.com/tcltk/tcl/workflows/macOS/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Amain) ## Contents 1. [Introduction](#intro) 2. [Documentation](#doc) 3. [Compiling and installing Tcl](#build) 4. [Development tools](#devtools) 5. [Tcl newsgroup](#complangtcl) |
︙ | ︙ | |||
25 26 27 28 29 30 31 | When paired with the Tk toolkit, Tcl provides the fastest and most powerful way to create GUI applications that run on PCs, Unix, and Mac OS X. Tcl can also be used for a variety of web-related tasks and for creating powerful command languages for applications. Tcl is maintained, enhanced, and distributed freely by the Tcl community. Source code development and tracking of bug reports and feature requests | | | | | 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 | When paired with the Tk toolkit, Tcl provides the fastest and most powerful way to create GUI applications that run on PCs, Unix, and Mac OS X. Tcl can also be used for a variety of web-related tasks and for creating powerful command languages for applications. Tcl is maintained, enhanced, and distributed freely by the Tcl community. Source code development and tracking of bug reports and feature requests take place at [core.tcl-lang.org](https://core.tcl-lang.org/). Tcl/Tk release and mailing list services are [hosted by SourceForge](https://sourceforge.net/projects/tcl/) with the Tcl Developer Xchange hosted at [www.tcl-lang.org](https://www.tcl-lang.org). Tcl is a freely available open-source package. You can do virtually 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.tk/software/tcltk/9.0.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 |
︙ | ︙ | |||
84 85 86 87 88 89 90 | ## <a id="build">3.</a> Compiling and installing Tcl There are brief notes in the `unix/README`, `win/README`, and `macosx/README` about compiling on these different platforms. There is additional information about building Tcl from sources [online](https://www.tcl-lang.org/doc/howto/compile.html). ## <a id="devtools">4.</a> Development tools | | | | | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 | ## <a id="build">3.</a> Compiling and installing Tcl There are brief notes in the `unix/README`, `win/README`, and `macosx/README` about compiling on these different platforms. There is additional information about building Tcl from sources [online](https://www.tcl-lang.org/doc/howto/compile.html). ## <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 http://www.ActiveState.com/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. ## <a id="wiki">6.</a> Tcl'ers Wiki There is a [wiki-based open community site](https://wiki.tcl-lang.org/) covering all aspects of Tcl/Tk. |
︙ | ︙ |
Changes to changes.
︙ | ︙ | |||
8988 8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 | 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) - Released 8.6.10, Nov 21, 2019 - details at http://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) 2017-11-03 [TIP 345] eliminate the encoding 'identity' (porter) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 8988 8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 9012 9013 9014 9015 9016 9017 9018 9019 9020 9021 9022 9023 9024 9025 9026 9027 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 9055 9056 9057 9058 9059 9060 9061 9062 9063 9064 9065 9066 9067 9068 9069 9070 9071 9072 9073 9074 9075 9076 9077 9078 9079 9080 9081 9082 9083 9084 9085 9086 9087 9088 9089 9090 9091 9092 9093 9094 9095 9096 9097 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 | 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) - Released 8.6.10, Nov 21, 2019 - details at http://core.tcl-lang.org/tcl/ - 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 http://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) 2017-11-03 [TIP 345] eliminate the encoding 'identity' (porter) |
︙ | ︙ |
Changes to doc/AddErrInfo.3.
︙ | ︙ | |||
296 297 298 299 300 301 302 303 304 305 306 307 | 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 | > > > > > > > > > > > > > > > > | 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 | 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 | '\" '\" 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 | '\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_Alloc 3 9.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetMemoryInfo \- allocate or free heap memory .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp char * \fBTcl_Alloc\fR(\fIsize\fR) .sp void \fBTcl_Free\fR(\fIptr\fR) .sp void * \fBTcl_Realloc\fR(\fIptr, size\fR) .sp void * \fBTcl_AttemptAlloc\fR(\fIsize\fR) .sp void * \fBTcl_AttemptRealloc\fR(\fIptr, size\fR) .sp void \fBTcl_GetMemoryInfo\fR(\fIdsPtr\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 |
︙ | ︙ | |||
64 65 66 67 68 69 70 71 72 73 | platforms, but not all, attempting to allocate a zero-sized block of memory will also cause these functions to return NULL. .PP When a module or Tcl itself is compiled with \fBTCL_MEM_DEBUG\fR defined, the procedures \fBTcl_Alloc\fR, \fBTcl_Free\fR, \fBTcl_Realloc\fR, \fBTcl_AttemptAlloc\fR, and \fBTcl_AttempRealloc\fR are implemented as macros, redefined to be special debugging versions of these procedures. .SH KEYWORDS alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG | > > > > > > > | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | platforms, but not all, attempting to allocate a zero-sized block of memory will also cause these functions to return NULL. .PP When a module or Tcl itself is compiled with \fBTCL_MEM_DEBUG\fR defined, the procedures \fBTcl_Alloc\fR, \fBTcl_Free\fR, \fBTcl_Realloc\fR, \fBTcl_AttemptAlloc\fR, and \fBTcl_AttempRealloc\fR are implemented as macros, redefined to be special debugging versions of these procedures. \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 When used in stub-enabled embedders, the stubs table must be first initialized using one of \fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, \fBTcl_FindExecutable\fR or \fBTclZipfs_AppHook\fR. .SH KEYWORDS alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG |
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.
︙ | ︙ | |||
33 34 35 36 37 38 39 | The length of the array of bytes. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to byte-array type. For \fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points to the value from which to get the byte-array value; if \fIobjPtr\fR does not already point to a byte-array value, it will be converted to one. | | | > | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | The length of the array of bytes. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to byte-array type. For \fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points to the value from which to get the byte-array value; if \fIobjPtr\fR does not already point to a byte-array value, it will be converted to one. .AP size_t | int *lengthPtr out Filled with the length of the array of bytes in the value. May be (int *)NULL when not used. .BE .SH DESCRIPTION .PP These procedures are used to create, modify, and read Tcl byte-array values from C code. Byte-array values are typically used to hold the results of binary IO operations or data structures created with the |
︙ | ︙ | |||
80 81 82 83 84 85 86 87 88 89 90 91 | array of bytes. If \fIlength\fR is greater than the space currently allocated for the array, the array is reallocated to the new length; the newly allocated bytes at the end of the array have arbitrary values. If \fIlength\fR is less than the space currently allocated for the array, the length of array is reduced to the new length. The return value is a pointer to the value's new array of bytes. .SH "SEE ALSO" Tcl_GetStringFromObj, Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount .SH KEYWORDS value, binary data, byte array, utf, unicode, internationalization | > > > > > > > > > > > > | 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | array of bytes. If \fIlength\fR is greater than the space currently allocated for the array, the array is reallocated to the new length; the newly allocated bytes at the end of the array have arbitrary values. If \fIlength\fR is less than the space currently allocated for the array, the length of array is reduced to the new length. The return value is a pointer to the value's new array of bytes. .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_GetByteArrayFromObj\fR does not modify the reference count of its \fIobjPtr\fR argument; it only reads. .SH "SEE ALSO" Tcl_GetStringFromObj, Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount .SH KEYWORDS value, binary data, byte array, utf, unicode, internationalization |
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.
︙ | ︙ | |||
237 238 239 240 241 242 243 244 245 246 247 248 249 250 | 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 | > > > > > > > > > > > > > > > > > > > > > > > | 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 | 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 |
︙ | ︙ |
Changes to doc/CrtAlias.3.
︙ | ︙ | |||
224 225 226 227 228 229 230 231 | 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" | > > > > > > > > | | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 | 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/CrtChannel.3.
︙ | ︙ | |||
249 250 251 252 253 254 255 | outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to 4096. .PP \fBTcl_NotifyChannel\fR is called by a channel driver to indicate to the generic layer that the events specified by \fImask\fR have occurred on the channel. Channel drivers are responsible for invoking this function whenever the channel handlers need to be called for the | > | | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 | outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to 4096. .PP \fBTcl_NotifyChannel\fR is called by a channel driver to indicate to the generic layer that the events specified by \fImask\fR have occurred on the channel. Channel drivers are responsible for invoking this function whenever the channel handlers need to be called for the channel (or other pending tasks like a write flush should be performed). See \fBWATCHPROC\fR below for more details. .PP \fBTcl_BadChannelOption\fR is called from driver specific \fIsetOptionProc\fR or \fIgetOptionProc\fR to generate a complete error message. .PP \fBTcl_ChannelBuffered\fR returns the number of bytes of input currently buffered in the internal buffer (push back area) of the |
︙ | ︙ | |||
757 758 759 760 761 762 763 | The \fItruncateProc\fR field contains the address of the function called by the generic layer when a channel is truncated to some length. It can be NULL. .PP .CS typedef int \fBTcl_DriverTruncateProc\fR( void *\fIinstanceData\fR, | | | 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 | The \fItruncateProc\fR field contains the address of the function called by the generic layer when a channel is truncated to some length. It can be NULL. .PP .CS typedef int \fBTcl_DriverTruncateProc\fR( void *\fIinstanceData\fR, long long \fIlength\fR); .CE .PP \fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR when this channel was created, and \fIlength\fR is the new length of the underlying file, which should not be negative. The result should be 0 on success or an errno code (suitable for use with \fBTcl_SetErrno\fR) on failure. |
︙ | ︙ |
Changes to doc/CrtObjCmd.3.
︙ | ︙ | |||
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.
1 2 3 | '\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. | | | 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. '\" Copyright (c) 2002 Kevin B. Kenny <[email protected]>. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures" .so man.macros .BS |
︙ | ︙ | |||
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/DumpActiveMemory.3.
1 | '\" | | | | 1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans. '\" Copyright (c) 2000 Scriptics Corporation. '\" All rights reserved. '\" .TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface |
︙ | ︙ |
Changes to doc/Encoding.3.
︙ | ︙ | |||
519 520 521 522 523 524 525 526 527 | 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 | > > > > > > > > > > > | 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 | 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.
︙ | ︙ | |||
186 187 188 189 190 191 192 193 194 195 | 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 | > > > > > > > > > > > > > > | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | 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 |
︙ | ︙ | |||
140 141 142 143 144 145 146 | .sp Tcl_Obj * \fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR) .sp Tcl_StatBuf * \fBTcl_AllocStatBuf\fR() .sp | | | | | | > > | 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 | .sp Tcl_Obj * \fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR) .sp Tcl_StatBuf * \fBTcl_AllocStatBuf\fR() .sp long long \fBTcl_GetAccessTimeFromStat\fR(\fIstatPtr\fR) .sp unsigned \fBTcl_GetBlockSizeFromStat\fR(\fIstatPtr\fR) .sp unsigned long long \fBTcl_GetBlocksFromStat\fR(\fIstatPtr\fR) .sp long long \fBTcl_GetChangeTimeFromStat\fR(\fIstatPtr\fR) .sp int \fBTcl_GetDeviceTypeFromStat\fR(\fIstatPtr\fR) .sp unsigned \fBTcl_GetFSDeviceFromStat\fR(\fIstatPtr\fR) .sp unsigned \fBTcl_GetFSInodeFromStat\fR(\fIstatPtr\fR) .sp int \fBTcl_GetGroupIdFromStat\fR(\fIstatPtr\fR) .sp int \fBTcl_GetLinkCountFromStat\fR(\fIstatPtr\fR) .sp unsigned \fBTcl_GetModeFromStat\fR(\fIstatPtr\fR) .sp long long \fBTcl_GetModificationTimeFromStat\fR(\fIstatPtr\fR) .sp unsigned long long \fBTcl_GetSizeFromStat\fR(\fIstatPtr\fR) .sp int \fBTcl_GetUserIdFromStat\fR(\fIstatPtr\fR) .SH ARGUMENTS .AS Tcl_GlobTypeData **srcPathPtr out .AP "const Tcl_Filesystem" *fsPtr in Points to a structure containing the addresses of procedures that can be called to perform the various filesystem operations. .AP Tcl_Obj *pathPtr in The path represented by this value is used for the operation in question. If the value does not already have an internal \fBpath\fR 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 void **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 | .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 |
︙ | ︙ |
Changes to doc/GetHostName.3.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 1998-2000 Scriptics Corporation. '\" All rights reserved. '\" .TH Tcl_GetHostName 3 8.3 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_GetHostName \- get the name of the local host |
︙ | ︙ |
Changes to doc/GetIndex.3.
︙ | ︙ | |||
101 102 103 104 105 106 107 108 109 110 111 | 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 "SEE ALSO" prefix(n), Tcl_WrongNumArgs(3) .SH KEYWORDS index, option, value, table lookup | > > > > > > | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 | 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/GetStdChan.3.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures" .so man.macros .BS |
︙ | ︙ |
Changes to doc/GetTime.3.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 2001 Kevin B. Kenny <[email protected]>. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures" .so man.macros .BS |
︙ | ︙ |
Changes to doc/Hash.3.
︙ | ︙ | |||
320 321 322 323 324 325 326 327 328 | 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 | > > > > > > > > > > > > > > | 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 | 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 | '\" | | | > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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) 1998-2000 Scriptics Corporation. '\" All rights reserved. '\" .TH Tcl_Init 3 9.0 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. When used in stub-enabled embedders, the stubs table must be first initialized using one of \fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, \fBTcl_FindExecutable\fR or \fBTclZipfs_AppHook\fR before \fBTcl_SetPreInitScript\fR may be called. .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 | .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 |
︙ | ︙ |
Changes to doc/IntObj.3.
︙ | ︙ | |||
98 99 100 101 102 103 104 | with which values might be exchanged. The C integral types for which Tcl provides value exchange routines are \fBint\fR, \fBlong int\fR, \fBTcl_WideInt\fR, and \fBmp_int\fR. The \fBint\fR and \fBlong int\fR types are provided by the C language standard. The \fBTcl_WideInt\fR type is a typedef defined to be whatever signed integral type covers at least the 64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending on the platform and the C compiler, the actual type might be | | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | with which values might be exchanged. The C integral types for which Tcl provides value exchange routines are \fBint\fR, \fBlong int\fR, \fBTcl_WideInt\fR, and \fBmp_int\fR. The \fBint\fR and \fBlong int\fR types are provided by the C language standard. The \fBTcl_WideInt\fR type is a typedef defined to be whatever signed integral type covers at least the 64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending on the platform and the C compiler, the actual type might be \fBlong long int\fR, or something else. The \fBmp_int\fR type is a multiple-precision integer type defined by the LibTomMath multiple-precision integer library. .PP The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, and \fBTcl_NewBignumObj\fR routines each create and return a new Tcl value initialized to the integral value of the argument. The returned Tcl value is unshared. |
︙ | ︙ | |||
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.
︙ | ︙ | |||
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.
1 | .\" | | | | 1 2 3 4 5 6 7 8 9 10 | .\" .\" Copyright (c) 2008 Kevin B. Kenny. .\" Copyright (c) 2018 Nathan Coulter. .\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH NRE 3 8.6 Tcl "Tcl Library Procedures" .so man.macros .BS |
︙ | ︙ | |||
223 224 225 226 227 228 229 230 231 232 233 234 | 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 | > > > > > > > > > > > > > > > > > > > | | | 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/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.
︙ | ︙ | |||
88 89 90 91 92 93 94 | .sp int \fBTcl_InputBuffered\fR(\fIchannel\fR) .sp int \fBTcl_OutputBuffered\fR(\fIchannel\fR) .sp | | | | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | .sp int \fBTcl_InputBuffered\fR(\fIchannel\fR) .sp int \fBTcl_OutputBuffered\fR(\fIchannel\fR) .sp long long \fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR) .sp long long \fBTcl_Tell\fR(\fIchannel\fR) .sp int \fBTcl_TruncateChannel\fR(\fIchannel, length\fR) .sp int \fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR) |
︙ | ︙ | |||
186 187 188 189 190 191 192 | .AP "const char" *charBuf in A buffer containing the characters to output to the channel. .AP "const char" *byteBuf in A buffer containing the bytes to output to the channel. .AP size_t bytesToWrite in The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and output to the channel. | | | | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 | .AP "const char" *charBuf in A buffer containing the characters to output to the channel. .AP "const char" *byteBuf in A buffer containing the bytes to output to the channel. .AP size_t bytesToWrite in The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and output to the channel. .AP "long long" offset in How far to move the access point in the channel at which the next input or output operation will be applied, measured in bytes from the position given by \fIseekMode\fR. May be either positive or negative. .AP int seekMode in Relative to which point to seek; used with \fIoffset\fR to calculate the new access point for the channel. Legal values are \fBSEEK_SET\fR, \fBSEEK_CUR\fR, and \fBSEEK_END\fR. .AP "long long" length in The (non-negative) length to truncate the channel the channel to. .AP "const char" *optionName in The name of an option applicable to this channel, such as \fB\-blocking\fR. May have any of the values accepted by the \fBfconfigure\fR command. .AP Tcl_DString *optionValue in Where to store the value of an option or a list of all options and their values. Must have been initialized by the caller. |
︙ | ︙ | |||
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.
︙ | ︙ | |||
11 12 13 14 15 16 17 | .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp void \fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) .sp | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp void \fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\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 |
︙ | ︙ |
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/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/RegConfig.3.
︙ | ︙ | |||
24 25 26 27 28 29 30 | registered for. Must not be NULL. .AP "const char" *pkgName in Contains the name of the package registering the embedded configuration as ASCII string. This means that this information is in UTF-8 too. Must not be NULL. .AP "const Tcl_Config" *configuration in Refers to an array of Tcl_Config entries containing the information | | | | | 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 | registered for. Must not be NULL. .AP "const char" *pkgName in Contains the name of the package registering the embedded configuration as ASCII string. This means that this information is in UTF-8 too. Must not be NULL. .AP "const Tcl_Config" *configuration in Refers to an array of Tcl_Config entries containing the information embedded in the library. Must not be NULL. The end of the array is signaled by either a key identical to NULL, or a key referring to the empty string. .AP "const char" *valEncoding in Contains the name of the encoding used to store the configuration values as ASCII string. This means that this information is in UTF-8 too. Must not be NULL. .BE .SH DESCRIPTION .PP The function described here has its base in TIP 59 and provides extensions with support for the embedding of configuration information into their library and the generation of a Tcl-level interface for querying this information. .PP To embed configuration information into their library an extension has to define a non-volatile array of Tcl_Config entries in one if its source files and then call \fBTcl_RegisterConfig\fR to register that information. .PP \fBTcl_RegisterConfig\fR takes four arguments; first, a reference to the interpreter we are registering the information with, second, the name of the package registering its configuration information, third, |
︙ | ︙ | |||
104 105 106 107 108 109 110 | const char *\fIkey\fR; const char *\fIvalue\fR; } \fBTcl_Config\fR; .CE .\" No cross references yet. .\" .SH "SEE ALSO" .SH KEYWORDS | | | 104 105 106 107 108 109 110 111 | const char *\fIkey\fR; const char *\fIvalue\fR; } \fBTcl_Config\fR; .CE .\" No cross references yet. .\" .SH "SEE ALSO" .SH KEYWORDS embedding, configuration, library |
Changes to doc/RegExp.3.
︙ | ︙ | |||
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/SaveResult.3.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 1997 Sun Microsystems, Inc. '\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright) '\" Copyright (c) 2018 Nathan Coulter. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures" |
︙ | ︙ |
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 |
︙ | ︙ | |||
126 127 128 129 130 131 132 133 134 135 136 | .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 | > > > > > > > > > | 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | .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.
︙ | ︙ | |||
210 211 212 213 214 215 216 217 218 219 220 221 | .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 | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | .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/SourceRCFile.3.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 1998-2000 Scriptics Corporation. '\" All rights reserved. '\" .TH Tcl_SourceRCFile 3 8.3 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_SourceRCFile \- source the Tcl rc file |
︙ | ︙ |
Added doc/StaticLibrary.3.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 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. Normally in titlecase (first letter upper-case, all others lower-case), but this is no longer required. .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 safely used by stub-enabled extensions, so its symbol is not included in the stub table. .SH KEYWORDS initialization procedure, package, static linking .SH "SEE ALSO" load(n), package(n), Tcl_PkgRequire(3) |
Deleted doc/StaticPkg.3.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to doc/StdChannels.3.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 2001 ActiveState Corporation '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures" .so man.macros .BS |
︙ | ︙ |
Changes to doc/StringObj.3.
︙ | ︙ | |||
112 113 114 115 116 117 118 | .AP size_t last in The index of the last Unicode character in the Unicode range to be returned as a new value. .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. | | | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | .AP size_t last in The index of the last Unicode character in the Unicode range to be returned as a new value. .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 size_t | 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. .AP size_t limit in Maximum number of bytes to be appended. |
︙ | ︙ | |||
370 371 372 373 374 375 376 377 378 379 380 381 | 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 | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | 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\fB, \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/TCL_MEM_DEBUG.3.
1 | '\" | | | | 1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans. '\" Copyright (c) 2000 Scriptics Corporation. '\" All rights reserved. '\" .TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging |
︙ | ︙ |
Changes to doc/Tcl.n.
︙ | ︙ | |||
220 221 222 223 224 225 226 | twenty-one-bit hexadecimal value for the Unicode character that will be inserted, in the range U+000000\(enU+10FFFF. The parser will stop just before this range overflows, or when the maximum of eight digits is reached. The upper bits of the Unicode character will be 0. .RS .PP The range U+00D800\(enU+00DFFF is reserved for surrogates, which | | | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 | twenty-one-bit hexadecimal value for the Unicode character that will be inserted, in the range U+000000\(enU+10FFFF. The parser will stop just before this range overflows, or when the maximum of eight digits is reached. The upper bits of the Unicode character will be 0. .RS .PP The range U+00D800\(enU+00DFFF is reserved for surrogates, which are illegal on their own. Therefore, such sequences will result in the replacement character U+FFFD. Surrogate pairs should be encoded as single \e\fBU\fIhhhhhhhh\fR character. .RE .PP Backslash substitution is not performed on words enclosed in braces, except for backslash-newline as described above. .RE |
︙ | ︙ |
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 | '\" '\" 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. '\" | | | > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 9.0 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 218 219 220 221 222 | 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. .PP The difference between Tcl_MainEx and Tcl_MainExW is that the arguments are passed as characters or wide characters. When used in stub-enabled embedders, the stubs table must be first initialized using one of \fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, \fBTcl_FindExecutable\fR or \fBTclZipfs_AppHook\fR. .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/ToUpper.3.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" 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_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS |
︙ | ︙ |
Changes to doc/TraceVar.3.
︙ | ︙ | |||
356 357 358 359 360 361 362 363 364 365 366 367 368 369 | 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 | > > > > > > > > | 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 | 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/Utf.3.
︙ | ︙ | |||
227 228 229 230 231 232 233 | \fBTcl_UtfNcasecmp\fR corresponds to \fBstrncasecmp\fR for UTF-8 strings. It is similar to \fBTcl_UtfNcmp\fR except comparisons ignore differences in case when comparing upper, lower or title case characters. .PP \fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR of \fIlength\fR bytes is long enough to be decoded by | | | | | | > | | | 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 | \fBTcl_UtfNcasecmp\fR corresponds to \fBstrncasecmp\fR for UTF-8 strings. It is similar to \fBTcl_UtfNcmp\fR except comparisons ignore differences in case when comparing upper, lower or title case characters. .PP \fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR of \fIlength\fR bytes is long enough to be decoded by \fBTcl_UtfToUniChar\fR/\fBTcl_UtfNext\fR, or 0 otherwise. This function does not guarantee that the UTF-8 string is properly formed. This routine is used by procedures that are operating on a byte at a time and need to know if a full Unicode character has been seen. .PP \fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings. It returns the number of Tcl_UniChars that are represented by the UTF-8 string \fIsrc\fR. The length of the source string is \fIlength\fR bytes. If the length is negative, all bytes up to the first null byte are used. .PP \fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings. It returns a pointer to the first occurrence of the Unicode character \fIch\fR in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is considered part of the UTF-8 string. .PP \fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings. It returns a pointer to the last occurrence of the Unicode character \fIch\fR in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is considered part of the UTF-8 string. .PP Given \fIsrc\fR, a pointer to some location in a UTF-8 string, \fBTcl_UtfNext\fR returns a pointer to the next UTF-8 character in the string. The caller must not ask for the next character after the last character in the string if the string is not terminated by a null character. \fBTcl_UtfCharComplete\fR can be used in that case to make sure enough bytes are available before calling \fBTcl_UtfNext\fR. .PP \fBTcl_UtfPrev\fR is used to step backward through but not beyond the UTF-8 string that begins at \fIstart\fR. If the UTF-8 string is made up entirely of complete and well-formed characters, and \fIsrc\fR points to the lead byte of one of those characters (or to the location one byte past the end of the string), then repeated calls of \fBTcl_UtfPrev\fR will return pointers to the lead bytes of each character in the string, one character at a time, terminating when it returns \fIstart\fR. .PP When the conditions of completeness and well-formedness may not be satisfied, a more precise description of the function of \fBTcl_UtfPrev\fR is necessary. It always returns a pointer greater than or equal to \fIstart\fR; that is, always a pointer to a location in the string. It always returns a pointer to a byte that begins a character when scanning for characters beginning from \fIstart\fR. When \fIsrc\fR is greater than \fIstart\fR, it always returns a pointer less than \fIsrc\fR and greater than or equal to (\fIsrc\fR - 4). The character that begins at the returned pointer is the first one that either includes the byte \fIsrc[-1]\fR, or might include it if the right trail bytes are present at \fIsrc\fR and greater. \fBTcl_UtfPrev\fR never reads the byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte \fIsrc[-5]\fR. .PP \fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the Pascal Ord() function. It returns the Unicode character represented at the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. If \fIindex\fR is TCL_INDEX_NONE or \fIindex\fR points to the second half of a surrogate pair, it returns -1. |
︙ | ︙ |
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/abstract.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::abstract \- a class that does not allow direct instances of itself .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::abstract \- a class that does not allow direct instances of itself .SH SYNOPSIS .nf package require tcl::oo \fBoo::abstract\fI method \fR?\fIarg ...\fR? .fi .SH "CLASS HIERARCHY" .nf \fBoo::object\fR \(-> \fBoo::class\fR |
︙ | ︙ |
Changes to doc/binary.n.
1 | '\" | | | | 1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1997 Sun Microsystems, Inc. '\" Copyright (c) 2008 Donal K. Fellows '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH binary n 8.0 Tcl "Tcl Built-In Commands" .so man.macros .BS |
︙ | ︙ | |||
758 759 760 761 762 763 764 765 766 767 768 769 770 771 | .CS \fBbinary scan\fR \ex70\ex87\ex05 B5B* var1 var2 .CE .PP will return \fB2\fR with \fB01110\fR stored in \fIvar1\fR and \fB1000011100000101\fR stored in \fIvar2\fR. .RE .IP \fBH\fR 5 The data is turned into a string of \fIcount\fR hexadecimal digits in high-to-low order represented as a sequence of characters in the set .QW 0123456789abcdef . The data bytes are scanned in first to last order with the hex digits being taken in high-to-low order within each byte. Any extra bits in the last byte are ignored. If \fIcount\fR is | > > > > > > > > > | 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 | .CS \fBbinary scan\fR \ex70\ex87\ex05 B5B* var1 var2 .CE .PP will return \fB2\fR with \fB01110\fR stored in \fIvar1\fR and \fB1000011100000101\fR stored in \fIvar2\fR. .RE .IP \fBC\fR 5 This form is similar to \fBA\fR, except that it scans the data from start and terminates at the first null (C string semantics). For example, .RS .CS \fBbinary scan\fR "abc\e000efghi" C* var1 .CE will return \fB1\fR with \fBabc\fR stored in \fIvar1\fR. .RE .IP \fBH\fR 5 The data is turned into a string of \fIcount\fR hexadecimal digits in high-to-low order represented as a sequence of characters in the set .QW 0123456789abcdef . The data bytes are scanned in first to last order with the hex digits being taken in high-to-low order within each byte. Any extra bits in the last byte are ignored. If \fIcount\fR is |
︙ | ︙ |
Changes to doc/callback.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME callback, mymethod \- generate callbacks to methods .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME callback, mymethod \- generate callbacks to methods .SH SYNOPSIS .nf package require tcl::oo \fBcallback\fR \fImethodName\fR ?\fIarg ...\fR? \fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR? .fi .BE .SH DESCRIPTION The \fBcallback\fR command, |
︙ | ︙ |
Changes to doc/chan.n.
︙ | ︙ | |||
171 172 173 174 175 176 177 | operating system, as returned by \fBencoding system\fR. .RE .TP \fB\-eofchar\fR \fIchar\fR .TP \fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR . | | | | 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 | operating system, as returned by \fBencoding system\fR. .RE .TP \fB\-eofchar\fR \fIchar\fR .TP \fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR . This option supports DOS file systems that use Control-z (\ex1A) as an end of file marker. If \fIchar\fR is not an empty string, then this character signals end-of-file when it is encountered during input. For output, the end-of-file character is output when the channel is closed. If \fIchar\fR is the empty string, then there is no special end of file character marker. For read-write channels, a two-element list specifies the end of file marker for input and output, respectively. As a convenience, when setting the end-of-file character for a read-write channel you can specify a single value that will apply to both reading and writing. When querying the end-of-file character of a read-write channel, a two-element list will always be returned. The default value for \fB\-eofchar\fR is the empty string in all cases except for files under Windows. In that case the \fB\-eofchar\fR is Control-z (\ex1A) for reading and the empty string for writing. The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f; attempting to set \fB\-eofchar\fR to a value outside of this range will generate an error. .TP \fB\-translation\fR \fImode\fR .TP |
︙ | ︙ |
Changes to doc/class.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::class \- class of all classes .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::class \- class of all classes .SH SYNOPSIS .nf package require tcl::oo \fBoo::class\fI method \fR?\fIarg ...\fR? .fi .SH "CLASS HIERARCHY" .nf \fBoo::object\fR \(-> \fBoo::class\fR |
︙ | ︙ |
Changes to doc/classvariable.n.
︙ | ︙ | |||
9 10 11 12 13 14 15 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME classvariable \- create link from local variable to variable in class .SH SYNOPSIS .nf | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME classvariable \- create link from local variable to variable in class .SH SYNOPSIS .nf package require tcl::oo \fBclassvariable\fR \fIvariableName\fR ?\fI...\fR? .fi .BE .SH DESCRIPTION The \fBclassvariable\fR command is available within methods. It takes a series of one or more variable names and makes them available in the method's scope; |
︙ | ︙ |
Changes to doc/clock.n.
1 2 3 4 5 6 7 8 9 10 | '\" '\" Generated from file './doc/clock.dt' by tcllib/doctools with format 'nroff' '\" Copyright (c) 2004 Kevin B. Kenny <[email protected]>. All rights reserved. '\" .TH "clock" n 8.5 Tcl "Tcl Built-In Commands" .so man.macros .BS .SH NAME clock \- Obtain and manipulate dates and times .SH "SYNOPSIS" | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | '\" '\" Generated from file './doc/clock.dt' by tcllib/doctools with format 'nroff' '\" Copyright (c) 2004 Kevin B. Kenny <[email protected]>. All rights reserved. '\" .TH "clock" n 8.5 Tcl "Tcl Built-In Commands" .so man.macros .BS .SH NAME clock \- Obtain and manipulate dates and times .SH "SYNOPSIS" package require \fBTcl 8.5-\fR .sp \fBclock add\fR \fItimeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR? .sp \fBclock clicks\fR ?\fI\-option\fR? .sp \fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...? .sp |
︙ | ︙ | |||
947 948 949 950 951 952 953 | differences and the correct date is given when going from the end of a long month to a short month. .SH "SEE ALSO" msgcat(n) .SH KEYWORDS clock, date, time .SH "COPYRIGHT" | | | 947 948 949 950 951 952 953 954 955 956 957 | differences and the correct date is given when going from the end of a long month to a short month. .SH "SEE ALSO" msgcat(n) .SH KEYWORDS clock, date, time .SH "COPYRIGHT" Copyright \(co 2004 Kevin B. Kenny <[email protected]>. All rights reserved. '\" Local Variables: '\" mode: nroff '\" End: |
Changes to doc/copy.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::copy \- create copies of objects and classes .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::copy \- create copies of objects and classes .SH SYNOPSIS .nf package require tcl::oo \fBoo::copy\fI sourceObject \fR?\fItargetObject\fR? ?\fItargetNamespace\fR? .fi .BE .SH DESCRIPTION .PP The \fBoo::copy\fR command creates a copy of an object or class. It takes the |
︙ | ︙ |
Changes to doc/define.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::define, oo::objdefine \- define and configure classes and objects .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::define, oo::objdefine \- define and configure classes and objects .SH SYNOPSIS .nf package require tcl::oo \fBoo::define\fI class defScript\fR \fBoo::define\fI class subcommand arg\fR ?\fIarg ...\fR? \fBoo::objdefine\fI object defScript\fR \fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR? .fi .BE |
︙ | ︙ |
Changes to doc/dict.n.
︙ | ︙ | |||
57 58 59 60 61 62 63 | The key rule only matches those key/value pairs whose keys match any of the given patterns (in the style of \fBstring match\fR.) .TP \fBdict filter \fIdictionaryValue \fBscript {\fIkeyVariable valueVariable\fB} \fIscript\fR . The script rule tests for matching by assigning the key to the \fIkeyVariable\fR and the value to the \fIvalueVariable\fR, and then evaluating | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | The key rule only matches those key/value pairs whose keys match any of the given patterns (in the style of \fBstring match\fR.) .TP \fBdict filter \fIdictionaryValue \fBscript {\fIkeyVariable valueVariable\fB} \fIscript\fR . The script rule tests for matching by assigning the key to the \fIkeyVariable\fR and the value to the \fIvalueVariable\fR, and then evaluating the given script which should result in a boolean value (with the key/value pair only being included in the result of the \fBdict filter\fR when a true value is returned.) Note that the first argument after the rule selection word is a two-element list. If the \fIscript\fR returns with a condition of \fBTCL_BREAK\fR, no further key/value pairs are considered for inclusion in the resulting dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false result. The key/value pairs are tested in the order in which the keys |
︙ | ︙ |
Changes to doc/encoding.n.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 1998 Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH encoding n "8.1" Tcl "Tcl Built-In Commands" .so man.macros .BS |
︙ | ︙ |
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 |
︙ | ︙ | |||
242 243 244 245 246 247 248 | accept arguments with forward slashes only as option delimiters and backslashes only in paths. Any arguments to an application that specify a path name with forward slashes will not automatically be converted to use the backslash character. If an argument contains forward slashes as the path separator, it may or may not be recognized as a path name, depending on the program. .PP | < < < < < < < < < | 246 247 248 249 250 251 252 253 254 255 256 257 258 259 | accept arguments with forward slashes only as option delimiters and backslashes only in paths. Any arguments to an application that specify a path name with forward slashes will not automatically be converted to use the backslash character. If an argument contains forward slashes as the path separator, it may or may not be recognized as a path name, depending on the program. .PP Two or more forward or backward slashes in a row in a path refer to a network path. For example, a simple concatenation of the root directory \fBc:/\fR with a subdirectory \fB/windows/system\fR will yield \fBc://windows/system\fR (two slashes together), which refers to the mount point called \fBsystem\fR on the machine called \fBwindows\fR (and the \fBc:/\fR is ignored), and is not equivalent to \fBc:/windows/system\fR, which describes a directory on the current computer. The \fBfile join\fR |
︙ | ︙ | |||
291 292 293 294 295 296 297 | application name, the following directories are automatically searched in order when attempting to locate the application: .IP \(bu 3 The directory from which the Tcl executable was loaded. .IP \(bu 3 The current directory. .IP \(bu 3 | | < < | | 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 | application name, the following directories are automatically searched in order when attempting to locate the application: .IP \(bu 3 The directory from which the Tcl executable was loaded. .IP \(bu 3 The current directory. .IP \(bu 3 The Windows 32-bit system directory. .IP \(bu 3 The Windows home directory. .IP \(bu 3 The directories listed in the path. .PP In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR, the caller must prepend the desired command with .QW "\fBcmd.exe /c\0\fR" because built-in commands are not implemented using executables. |
︙ | ︙ | |||
418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 | .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.
1 2 3 | '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-2000 Sun Microsystems, Inc. | | | 1 2 3 4 5 6 7 8 9 10 11 | '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-2000 Sun Microsystems, Inc. '\" Copyright (c) 2005 Kevin B. Kenny <[email protected]>. All rights reserved '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH expr n 8.5 Tcl "Tcl Built-In Commands" .so man.macros .BS |
︙ | ︙ | |||
37 38 39 40 41 42 43 44 45 46 47 48 49 50 | non-numeric operands, string comparisons, and some additional operators not found in C. .PP When an expression evaluates to an integer, the value is the decimal form of the integer, and when an expression evaluates to a floating-point number, the value is the form produced by the \fB%g\fR format specifier of Tcl's \fBformat\fR command. .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. .PP An operand may be specified in any of the following ways: | > > > > > > | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | non-numeric operands, string comparisons, and some additional operators not found in C. .PP When an expression evaluates to an integer, the value is the decimal form of the integer, and when an expression evaluates to a floating-point number, the value is the form produced by the \fB%g\fR format specifier of Tcl's \fBformat\fR command. .PP .VS "TIP 582" You can use \fB#\fR at any point in the expression (except inside double quotes or braces) to start a comment. Comments last 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. .PP An operand may be specified in any of the following ways: |
︙ | ︙ | |||
78 79 80 81 82 83 84 | .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 | | | | | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | .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 \fBInteger value\fR .PP An integer operand may be specified in decimal (the normal case, the optional first two characters are \fB0d\fR), binary |
︙ | ︙ | |||
264 265 266 267 268 269 270 | .PP As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature .QW "lazy evaluation" , which means that operands are not evaluated if they are not needed to determine the outcome. For example, in .PP .CS | | | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 | .PP As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature .QW "lazy evaluation" , which means that operands are not evaluated if they are not needed to determine the outcome. For example, in .PP .CS \fBexpr\fR {$v?[a]:[b]} .CE .PP only one of \fB[a]\fR or \fB[b]\fR is evaluated, depending on the value of \fB$v\fR. This is not true of the normal Tcl parser, so it is normally recommended to enclose the arguments to \fBexpr\fR in braces. Without braces, as in \fBexpr\fR $v ? [a] : [b] |
︙ | ︙ | |||
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 | .CE .PP Set a variable indicating whether an environment variable is defined and has value of true: .PP .CS set isTrue [\fBexpr\fR { [info exists ::env(SOME_ENV_VAR)] && [string is true -strict $::env(SOME_ENV_VAR)] }] .CE .PP Generate a random integer in the range 0..99 inclusive: .PP .CS set randNum [\fBexpr\fR { int(100 * rand()) }] .CE .SH "SEE ALSO" array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n), string(n), Tcl(n), while(n) .SH KEYWORDS arithmetic, boolean, compare, expression, fuzzy comparison, integer value .SH COPYRIGHT .nf Copyright \(co 1993 The Regents of the University of California. Copyright \(co 1994-2000 Sun Microsystems Incorporated. | > > | > | 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 | .CE .PP Set a variable indicating whether an environment variable is defined and has value of true: .PP .CS set isTrue [\fBexpr\fR { # Does the environment variable exist, and... [info exists ::env(SOME_ENV_VAR)] && # ...does it contain a proper true value? [string is true -strict $::env(SOME_ENV_VAR)] }] .CE .PP Generate a random integer in the range 0..99 inclusive: .PP .CS set randNum [\fBexpr\fR { int(100 * rand()) }] .CE .SH "SEE ALSO" array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n), string(n), Tcl(n), while(n) .SH KEYWORDS arithmetic, boolean, compare, expression, fuzzy comparison, integer value .SH COPYRIGHT .nf Copyright \(co 1993 The Regents of the University of California. Copyright \(co 1994-2000 Sun Microsystems Incorporated. Copyright \(co 2005 Kevin B. Kenny <[email protected]>. All rights reserved. .fi '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/fconfigure.n.
︙ | ︙ | |||
101 102 103 104 105 106 107 | system, as returned by \fBencoding system\fR. .RE .TP \fB\-eofchar\fR \fIchar\fR .TP \fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR . | | | | | 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 | system, as returned by \fBencoding system\fR. .RE .TP \fB\-eofchar\fR \fIchar\fR .TP \fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR . This option supports DOS file systems that use Control-z (\ex1A) as an end of file marker. If \fIchar\fR is not an empty string, then this character signals end-of-file when it is encountered during input. For output, the end-of-file character is output when the channel is closed. If \fIchar\fR is the empty string, then there is no special end of file character marker. For read-write channels, a two-element list specifies the end of file marker for input and output, respectively. As a convenience, when setting the end-of-file character for a read-write channel you can specify a single value that will apply to both reading and writing. When querying the end-of-file character of a read-write channel, a two-element list will always be returned. The default value for \fB\-eofchar\fR is the empty string in all cases except for files under Windows. In that case the \fB\-eofchar\fR is Control-z (\ex1A) for reading and the empty string for writing. The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7F; attempting to set \fB\-eofchar\fR to a value outside of this range will generate an error. .TP \fB\-translation\fR \fImode\fR .TP \fB\-translation\fR \fB{\fIinMode outMode\fB}\fR . |
︙ | ︙ |
Changes to doc/file.n.
︙ | ︙ | |||
34 35 36 37 38 39 40 | .TP \fBfile attributes \fIname\fR .TP \fBfile attributes \fIname\fR ?\fIoption\fR? .TP \fBfile attributes \fIname\fR ?\fIoption value option value...\fR? . | | | | | | | | | | | > | < > > | | | | | | | | > | 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 | .TP \fBfile attributes \fIname\fR .TP \fBfile attributes \fIname\fR ?\fIoption\fR? .TP \fBfile attributes \fIname\fR ?\fIoption value option value...\fR? . This subcommand returns or sets platform-specific values associated with a file. The first form returns a list of the platform-specific options and their values. The second form returns the value for the given option. The third form sets one or more of the values. The values are as follows: .RS .PP On Unix, \fB\-group\fR gets or sets the group name for the file. A group id can be given to the command, but it returns a group name. \fB\-owner\fR gets or sets the user name of the owner of the file. The command returns the owner name, but the numerical id can be passed when setting the owner. \fB\-permissions\fR retrieves or sets a file's access permissions, using octal notation by default. This option also provides limited support for setting permissions using the symbolic notation accepted by the \fBchmod\fR command, following the form [\fBugo\fR]?[[\fB+-=\fR][\fBrwxst\fR]\fB,\fR[...]]. Multiple permission specifications may be given, separated by commas. E.g., \fBu+s,go-rw\fR would set the setuid bit for a file's owner as well as remove read and write permission for the file's group and other users. An \fBls\fR-style string of the form \fBrwxrwxrwx\fR is also accepted but must always be 9 characters long. E.g., \fBrwxr-xr-t\fR is equivalent to \fB01755\fR. On versions of Unix supporting file flags, \fB-readonly\fR returns the value of, or sets, or clears the readonly attribute of a file, i.e., the user immutable flag (\fBuchg\fR) to the \fBchflags\fR command. .PP On Windows, \fB\-archive\fR gives the value or sets or clears the archive attribute of the file. \fB\-hidden\fR gives the value or sets or clears the hidden attribute of the file. \fB\-longname\fR will expand each path element to its long version. This attribute cannot be set. \fB\-readonly\fR gives the value or sets or clears the readonly attribute of the file. \fB\-shortname\fR gives a string where every |
︙ | ︙ |
Changes to doc/filename.n.
︙ | ︙ | |||
146 147 148 149 150 151 152 | should choose file names that do not contain special characters like: \fB<>:?"/\e|\fR. '\""\" reset emacs highlighting The safest approach is to use names consisting of alphanumeric characters only. Care should be taken with filenames which contain spaces (common on Windows systems) and filenames where the backslash is the directory separator (Windows | | < < | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 | should choose file names that do not contain special characters like: \fB<>:?"/\e|\fR. '\""\" reset emacs highlighting The safest approach is to use names consisting of alphanumeric characters only. Care should be taken with filenames which contain spaces (common on Windows systems) and filenames where the backslash is the directory separator (Windows native path names). .PP On Windows platforms there are file and path length restrictions. Complete paths or filenames longer than about 260 characters will lead to errors in most file operations. .PP Another Windows peculiarity is that any number of trailing dots .QW . |
︙ | ︙ |
Changes to doc/fpclassify.n.
1 | '\" | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | '\" '\" Copyright (c) 2018 Kevin B. Kenny <[email protected]>. All rights reserved '\" Copyright (c) 2019 Donal Fellows '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH fpclassify n 8.7 Tcl "Tcl Float Classifier" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME fpclassify \- Floating point number classification of Tcl values .SH SYNOPSIS package require \fBtcl 8.7\fR .sp \fBfpclassify \fIvalue\fR .BE .SH DESCRIPTION The \fBfpclassify\fR command takes a floating point number, \fIvalue\fR, and returns one of the following strings that describe it: .TP |
︙ | ︙ | |||
72 73 74 75 76 77 78 | floating point .SH STANDARDS This command depends on the \fBfpclassify\fR() C macro conforming to .QW "ISO C99" (i.e., to ISO/IEC 9899:1999). .SH COPYRIGHT .nf | | | 72 73 74 75 76 77 78 79 80 81 82 83 | floating point .SH STANDARDS This command depends on the \fBfpclassify\fR() C macro conforming to .QW "ISO C99" (i.e., to ISO/IEC 9899:1999). .SH COPYRIGHT .nf Copyright \(co 2018 Kevin B. Kenny <[email protected]>. All rights reserved .fi '\" Local Variables: '\" mode: nroff '\" End: |
Changes to doc/http.n.
1 2 | '\" '\" Copyright (c) 1995-1997 Sun Microsystems, Inc. | | | 1 2 3 4 5 6 7 8 9 10 | '\" '\" 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.9 http "Tcl Bundled Packages" .so man.macros |
︙ | ︙ | |||
74 75 76 77 78 79 80 81 82 83 84 85 86 87 | the HTTP operation is done in the background. \fB::http::geturl\fR returns immediately after generating the HTTP request and the callback is invoked when the transaction completes. For this to work, the Tcl event loop must be active. In Tk applications this is always true. For pure-Tcl applications, the caller can use \fB::http::wait\fR after calling \fB::http::geturl\fR to start the event loop. .SH COMMANDS .TP \fB::http::config\fR ?\fIoptions\fR? . The \fB::http::config\fR command is used to set and query the name of the proxy server and port, and the User-Agent name used in the HTTP requests. If no options are specified, then the current configuration | > > > | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | the HTTP operation is done in the background. \fB::http::geturl\fR returns immediately after generating the HTTP request and the callback is invoked when the transaction completes. For this to work, the Tcl event loop must be active. In Tk applications this is always true. For pure-Tcl applications, the caller can use \fB::http::wait\fR after calling \fB::http::geturl\fR to start the event loop. .PP \fBNote:\fR The event queue is even used without the \fB-command\fR option. As a side effect, arbitrary commands may be processed while \fBhttp::geturl\fR is running. .SH COMMANDS .TP \fB::http::config\fR ?\fIoptions\fR? . The \fB::http::config\fR command is used to set and query the name of the proxy server and port, and the User-Agent name used in the HTTP requests. If no options are specified, then the current configuration |
︙ | ︙ | |||
321 322 323 324 325 326 327 | Select the HTTP protocol version to use. This should be 1.0 or 1.1 (the default). Should only be necessary for servers that do not understand or otherwise complain about HTTP/1.1. .TP \fB\-query\fR \fIquery\fR . This flag causes \fB::http::geturl\fR to do a POST request that passes the | > > > | | < | 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 | Select the HTTP protocol version to use. This should be 1.0 or 1.1 (the default). Should only be necessary for servers that do not understand or otherwise complain about HTTP/1.1. .TP \fB\-query\fR \fIquery\fR . This flag causes \fB::http::geturl\fR to do a POST request that passes the \fIquery\fR as payload verbatim to the server. The content format (and encoding) of \fIquery\fR is announced by the header field \fBcontent-type\fR set by the option \fB-type\fR. \fIquery\fR is an x-url-encoding formatted query, if used for html forms. The \fB::http::formatQuery\fR procedure can be used to do the formatting. .TP \fB\-queryblocksize\fR \fIsize\fR . The block size used when posting query data to the URL. At most \fIsize\fR bytes are written at once. After each block, a call to the |
︙ | ︙ | |||
547 548 549 550 551 552 553 554 555 556 557 558 559 560 | If the server closes the socket without replying, then no error is raised, but the status of the transaction will be \fBeof\fR. .TP \fBerror\fR . The error message will also be stored in the \fBerror\fR status array element, accessible via \fB::http::error\fR. .PP Another error possibility is that \fB::http::geturl\fR is unable to write all the post query data to the server before the server responds and closes the socket. The error message is saved in the \fBposterror\fR status array element and then \fB::http::geturl\fR attempts to complete the transaction. | > > > > > > > > | 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 | If the server closes the socket without replying, then no error is raised, but the status of the transaction will be \fBeof\fR. .TP \fBerror\fR . The error message will also be stored in the \fBerror\fR status array element, accessible via \fB::http::error\fR. .TP \fBtimeout\fR . A timeout occurred before the transaction could complete .TP \fBreset\fR . user-reset .PP Another error possibility is that \fB::http::geturl\fR is unable to write all the post query data to the server before the server responds and closes the socket. The error message is saved in the \fBposterror\fR status array element and then \fB::http::geturl\fR attempts to complete the transaction. |
︙ | ︙ | |||
662 663 664 665 666 667 668 | \fBposterror\fR . The error, if any, that occurred while writing the post query data to the server. .TP \fBstatus\fR . | | | < | | 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 | \fBposterror\fR . The error, if any, that occurred while writing the post query data to the server. .TP \fBstatus\fR . See description in the chapter \fBERRORS\fR above for a list and description of \fBstatus\fR. During the transaction this value is the empty string. .TP \fBtotalsize\fR . A copy of the \fBContent-Length\fR meta-data value. .TP \fBtype\fR . |
︙ | ︙ |
Changes to doc/lindex.n.
1 2 3 | '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. | | | 1 2 3 4 5 6 7 8 9 10 11 | '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 Kevin B. Kenny <[email protected]>. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH lindex n 8.4 Tcl "Tcl Built-In Commands" .so man.macros .BS |
︙ | ︙ |
Changes to doc/link.n.
︙ | ︙ | |||
9 10 11 12 13 14 15 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME link \- create link from command to method of object .SH SYNOPSIS .nf | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME link \- create link from command to method of object .SH SYNOPSIS .nf package require tcl::oo \fBlink\fR \fImethodName\fR ?\fI...\fR? \fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR? .fi .BE .SH DESCRIPTION The \fBlink\fR command is available within methods. It takes a series of one |
︙ | ︙ |
Changes to doc/load.n.
︙ | ︙ | |||
9 10 11 12 13 14 15 | .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME load \- Load machine code and initialize new commands .SH SYNOPSIS \fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName\fR .br | | | | < | | | | < < < | | | | | | | | | | | | | | < < | > | | | | | | | | | | | | 9 10 11 12 13 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 | .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME load \- Load machine code and initialize new commands .SH SYNOPSIS \fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName\fR .br \fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName prefix\fR .br \fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName prefix interp\fR .BE .SH DESCRIPTION .PP This command loads binary code from a file into the application's address space and calls an initialization procedure in the library to incorporate it into an interpreter. \fIfileName\fR is the name of the file containing the code; its exact form varies from system to system but on most systems it is a shared library, such as a \fB.so\fR file under Solaris or a DLL under Windows. \fIprefix\fR is used to compute the name of an initialization procedure. \fIinterp\fR is the path name of the interpreter into which to load the library (see the \fBinterp\fR manual entry for details); if \fIinterp\fR is omitted, it defaults to the interpreter in which the \fBload\fR command was invoked. .PP Once the file has been loaded into the application's address space, one of two initialization procedures will be invoked in the new code. Typically the initialization procedure will add new commands to a Tcl interpreter. The name of the initialization procedure is determined by \fIprefix\fR and whether or not the target interpreter is a safe one. For normal interpreters the name of the initialization procedure will have the form \fIprefix\fB_Init\fR. For example, if \fIprefix\fR is \fBFoo\fR, the initialization procedure's name will be \fBFoo_Init\fR. .PP If the target interpreter is a safe interpreter, then the name of the initialization procedure will be \fIprefix\fB_SafeInit\fR instead of \fIprefix\fB_Init\fR. The \fIprefix\fB_SafeInit\fR function should be written carefully, so that it 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 to point to an error message. The result of the \fBload\fR command will be the result returned by the initialization procedure. .PP The actual loading of a file will only be done once for each \fIfileName\fR in an application. If a given \fIfileName\fR is loaded into multiple interpreters, then the first \fBload\fR will load the code and call the initialization procedure; subsequent \fBload\fRs will call the initialization procedure without loading the code again. 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 by taking 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 \fBtcl9\fR, and use any following wordchars but not digits, 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 found in the shared library are exported for global use by other libraries. The option \fB\-lazy\fR delays the actual loading of symbols until their first actual use. The options may be abbreviated. The option \fB\-\-\fR indicates the end of the options, and should be used if you wish to use a filename which starts with \fB\-\fR and you provide a prefix to the \fBload\fR command. .PP On platforms which do not support the \fB\-global\fR or \fB\-lazy\fR options, the options still exist but have no effect. Note that use of the \fB\-global\fR or \fB\-lazy\fR option may lead to crashes in your application later (in case of symbol conflicts resp. missing symbols), which cannot be detected during the \fBload\fR. So, only use this when you know what you are doing, you will not get a nice |
︙ | ︙ | |||
184 185 186 187 188 189 190 | } } # Now execute the command defined by the extension foo .CE .SH "SEE ALSO" | | | 179 180 181 182 183 184 185 186 187 188 189 190 191 | } } # 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/lpop.n.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 2018 Peter Spjuth. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH lpop n 8.7 Tcl "Tcl Built-In Commands" .so man.macros .BS |
︙ | ︙ |
Changes to doc/lrepeat.n.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 2003 Simon Geard. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH lrepeat n 8.5 Tcl "Tcl Built-In Commands" .so man.macros .BS |
︙ | ︙ |
Changes to doc/lreverse.n.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 2006 Donal K. Fellows. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH lreverse n 8.5 Tcl "Tcl Built-In Commands" .so man.macros .BS |
︙ | ︙ |
Changes to doc/lset.n.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 2001 Kevin B. Kenny <[email protected]>. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH lset n 8.4 Tcl "Tcl Built-In Commands" .so man.macros .BS |
︙ | ︙ |
Changes to doc/mathfunc.n.
1 2 3 | '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-2000 Sun Microsystems, Inc. | | | | 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) 1993 The Regents of the University of California. '\" Copyright (c) 1994-2000 Sun Microsystems, Inc. '\" Copyright (c) 2005 Kevin B. Kenny <[email protected]>. All rights reserved '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME mathfunc \- Mathematical functions for Tcl expressions .SH SYNOPSIS package require \fBTcl 8.5-\fR .sp \fB::tcl::mathfunc::abs\fR \fIarg\fR .br \fB::tcl::mathfunc::acos\fR \fIarg\fR .br \fB::tcl::mathfunc::asin\fR \fIarg\fR .br |
︙ | ︙ | |||
353 354 355 356 357 358 359 | are returned as an integer value. .SH "SEE ALSO" expr(n), fpclassify(n), mathop(n), namespace(n) .SH "COPYRIGHT" .nf Copyright \(co 1993 The Regents of the University of California. Copyright \(co 1994-2000 Sun Microsystems Incorporated. | | | 353 354 355 356 357 358 359 360 361 362 363 364 365 | are returned as an integer value. .SH "SEE ALSO" expr(n), fpclassify(n), mathop(n), namespace(n) .SH "COPYRIGHT" .nf Copyright \(co 1993 The Regents of the University of California. Copyright \(co 1994-2000 Sun Microsystems Incorporated. Copyright \(co 2005-2006 Kevin B. Kenny <[email protected]>. .fi '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/mathop.n.
1 2 3 4 5 6 7 8 9 10 11 12 13 | .\" .\" Copyright (c) 2006-2007 Donal K. Fellows. .\" .\" See the file "license.terms" for information on usage and redistribution .\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. .\" .TH mathop n 8.5 Tcl "Tcl Mathematical Operator Commands" .so man.macros .BS .\" Note: do not modify the .SH NAME line immediately below! .SH NAME mathop \- Mathematical operators as Tcl commands .SH SYNOPSIS | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | .\" .\" Copyright (c) 2006-2007 Donal K. Fellows. .\" .\" See the file "license.terms" for information on usage and redistribution .\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. .\" .TH mathop n 8.5 Tcl "Tcl Mathematical Operator Commands" .so man.macros .BS .\" Note: do not modify the .SH NAME line immediately below! .SH NAME mathop \- Mathematical operators as Tcl commands .SH SYNOPSIS package require \fBTcl 8.5-\fR .sp \fB::tcl::mathop::!\fR \fInumber\fR .br \fB::tcl::mathop::~\fR \fInumber\fR .br \fB::tcl::mathop::+\fR ?\fInumber\fR ...? .br |
︙ | ︙ |
Changes to doc/memory.n.
1 | '\" | | | | 1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans '\" Copyright (c) 2000 Scriptics Corporation. '\" All rights reserved. '\" .TH memory n 8.1 Tcl "Tcl Built-In Commands" .so man.macros .BS .SH NAME memory \- Control Tcl memory debugging capabilities |
︙ | ︙ |
Changes to doc/msgcat.n.
1 2 3 4 5 6 7 8 9 10 11 12 13 | '\" '\" Copyright (c) 1998 Mark Harrison. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME msgcat \- Tcl message catalog .SH SYNOPSIS | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | '\" '\" Copyright (c) 1998 Mark Harrison. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME msgcat \- Tcl message catalog .SH SYNOPSIS \fBpackage require tcl 8.7\fR .sp \fBpackage require msgcat 1.7\fR .sp \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? .sp \fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR? .sp |
︙ | ︙ | |||
215 216 217 218 219 220 221 | .CS ::msgcat::mcpreferences fr en {} .CE .RE .PP .VS "TIP 499" .TP | | | 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | .CS ::msgcat::mcpreferences fr en {} .CE .RE .PP .VS "TIP 499" .TP \fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR? . This group of commands manage the list of loaded locales for packages not setting a package locale. .PP .RS The subcommand \fBget\fR returns the list of currently loaded locales. .PP The subcommand \fBpresent\fR requires the argument \fIlocale\fR and returns true, if this locale is loaded. |
︙ | ︙ |
Changes to doc/my.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME my, myclass \- invoke any method of current object or its class .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME my, myclass \- invoke any method of current object or its class .SH SYNOPSIS .nf package require tcl::oo \fBmy\fI methodName\fR ?\fIarg ...\fR? \fBmyclass\fI methodName\fR ?\fIarg ...\fR? .fi .BE .SH DESCRIPTION .PP |
︙ | ︙ |
Changes to doc/next.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME next, nextto \- invoke superclass method implementations .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME next, nextto \- invoke superclass method implementations .SH SYNOPSIS .nf package require tcl::oo \fBnext\fR ?\fIarg ...\fR? \fBnextto\fI class\fR ?\fIarg ...\fR? .fi .BE .SH DESCRIPTION |
︙ | ︙ |
Changes to doc/object.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::object \- root class of the class hierarchy .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::object \- root class of the class hierarchy .SH SYNOPSIS .nf package require tcl::oo \fBoo::object\fI method \fR?\fIarg ...\fR? .fi .SH "CLASS HIERARCHY" .nf \fBoo::object\fR .fi |
︙ | ︙ |
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/packagens.n.
1 | '\" | | | 1 2 3 4 5 6 7 8 9 | '\" '\" Copyright (c) 1998-2000 Scriptics Corporation. '\" All rights reserved. '\" .TH pkg::create n 8.3 Tcl "Tcl Built-In Commands" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME |
︙ | ︙ | |||
25 26 27 28 29 30 31 | \fB\-name \fIpackageName\fR This parameter specifies the name of the package. It is required. .TP \fB\-version \fIpackageVersion\fR This parameter specifies the version of the package. It is required. .TP \fB\-load \fIfilespec\fR | | | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | \fB\-name \fIpackageName\fR This parameter specifies the name of the package. It is required. .TP \fB\-version \fIpackageVersion\fR This parameter specifies the version of the package. It is required. .TP \fB\-load \fIfilespec\fR This parameter specifies a library that must be loaded with the \fBload\fR command. \fIfilespec\fR is a list with two elements. The first element is the name of the file to load. The second, optional element is a list of commands supplied by loading that file. If the list of procedures is empty or omitted, \fB::pkg::create\fR will set up the library for direct loading (see \fBpkg_mkIndex\fR). Any number of \fB\-load\fR parameters may be specified. .TP |
︙ | ︙ |
Changes to doc/re_syntax.n.
︙ | ︙ | |||
133 134 135 136 137 138 139 | are met. A constraint may not be followed by a quantifier. The simple constraints are as follows; some more constraints are described later, under \fBESCAPES\fR. .RS 2 .TP 8 \fB^\fR . | | > > | > > > > > > > > > > > > > | 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 | are met. A constraint may not be followed by a quantifier. The simple constraints are as follows; some more constraints are described later, under \fBESCAPES\fR. .RS 2 .TP 8 \fB^\fR . matches at the beginning of the string or a line (according to whether matching is newline-sensitive or not, as described in \fBMATCHING\fR, below). .TP \fB$\fR . matches at the end of the string or a line (according to whether matching is newline-sensitive or not, as described in \fBMATCHING\fR, below). .RS .PP The difference between string and line matching modes is immaterial when the string does not contain a newline character. The \fB\eA\fR and \fB\eZ\fR constraint escapes have a similar purpose but are always constraints for the overall string. .PP The default newline-sensitivity depends on the command that uses the regular expression, and can be overridden as described in \fBMETASYNTAX\fR, below. .RE .TP \fB(?=\fIre\fB)\fR . \fIpositive lookahead\fR (AREs only), matches at any point where a substring matching \fIre\fR begins .TP \fB(?!\fIre\fB)\fR |
︙ | ︙ | |||
289 290 291 292 293 294 295 | and \fB=]\fR is an equivalence class, standing for the sequences of characters of all collating elements equivalent to that one, including itself. (If there are no other equivalent collating elements, the treatment is as if the enclosing delimiters were .QW \fB[.\fR \& and .QW \fB.]\fR .) | | | | | 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 | and \fB=]\fR is an equivalence class, standing for the sequences of characters of all collating elements equivalent to that one, including itself. (If there are no other equivalent collating elements, the treatment is as if the enclosing delimiters were .QW \fB[.\fR \& and .QW \fB.]\fR .) For example, if \fBo\fR and \fB\(^o\fR are the members of an equivalence class, then .QW \fB[[=o=]]\fR , .QW \fB[[=\(^o=]]\fR , and .QW \fB[o\(^o]\fR \& are all synonymous. An equivalence class may not be an endpoint of a range. .RS .PP (\fINote:\fR Tcl implements only the Unicode locale. It does not define any equivalence classes. The examples above are just illustrations.) .RE .SH ESCAPES |
︙ | ︙ | |||
427 428 429 430 431 432 433 | .TP \fB\es\fR . \fB[[:space:]]\fR .TP \fB\ew\fR . | | | | 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 | .TP \fB\es\fR . \fB[[:space:]]\fR .TP \fB\ew\fR . \fB[[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters) .TP \fB\eD\fR . \fB[^[:digit:]]\fR .TP \fB\eS\fR . \fB[^[:space:]]\fR .TP \fB\eW\fR . \fB[^[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters) .RE .PP Within bracket expressions, .QW \fB\ed\fR , .QW \fB\es\fR , and .QW \fB\ew\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/self.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME self \- method call internal introspection .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME self \- method call internal introspection .SH SYNOPSIS .nf package require tcl::oo \fBself\fR ?\fIsubcommand\fR? .fi .BE .SH DESCRIPTION The \fBself\fR command, which should only be used from within the context of a call to a method (i.e. inside a method, constructor or destructor body) is |
︙ | ︙ |
Changes to doc/singleton.n.
︙ | ︙ | |||
8 9 10 11 12 13 14 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::singleton \- a class that does only allows one instance of itself .SH SYNOPSIS .nf | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME oo::singleton \- a class that does only allows one instance of itself .SH SYNOPSIS .nf package require tcl::oo \fBoo::singleton\fI method \fR?\fIarg ...\fR? .fi .SH "CLASS HIERARCHY" .nf \fBoo::object\fR \(-> \fBoo::class\fR |
︙ | ︙ |
Changes to doc/socket.n.
1 2 | '\" '\" Copyright (c) 1996 Sun Microsystems, Inc. | | | 1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1996 Sun Microsystems, Inc. '\" Copyright (c) 1998-1999 Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH socket n 8.6 Tcl "Tcl Built-In Commands" .so man.macros .BS |
︙ | ︙ |
Changes to doc/string.n.
︙ | ︙ | |||
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 | | | 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 | 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.) |
︙ | ︙ |
Changes to doc/tclsh.1.
︙ | ︙ | |||
40 41 42 43 44 45 46 | the medium, or by the character, .QW \e032 .PQ \eu001a ", control-Z" . If this character is present in the file, the \fBtclsh\fR application will read text up to but not including the character. An application that requires this character in the file may safely encode it as .QW \e032 , | | | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | the medium, or by the character, .QW \e032 .PQ \eu001a ", control-Z" . If this character is present in the file, the \fBtclsh\fR application will read text up to but not including the character. An application that requires this character in the file may safely encode it as .QW \e032 , .QW \ex1A , or .QW \eu001a ; or may generate it by use of commands such as \fBformat\fR or \fBbinary\fR. There is no automatic evaluation of \fB.tclshrc\fR when the name of a script file is presented on the \fBtclsh\fR command line, but the script file can always \fBsource\fR it if desired. .PP |
︙ | ︙ |
Changes to doc/tcltest.n.
︙ | ︙ | |||
1175 1176 1177 1178 1179 1180 1181 | because that is the default name used by \fBrunAllTests\fR when combining multiple test suites into one testing run. .IP [8] Here is a sketch of a sample test suite main script: .RS .PP .CS | < | 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 | because that is the default name used by \fBrunAllTests\fR when combining multiple test suites into one testing run. .IP [8] Here is a sketch of a sample test suite main script: .RS .PP .CS package require tcltest 2.5 package require example \fB::tcltest::configure\fR -testdir \e [file dirname [file normalize [info script]]] eval \fB::tcltest::configure\fR $argv \fB::tcltest::runAllTests\fR .CE |
︙ | ︙ |
Changes to doc/unload.n.
︙ | ︙ | |||
9 10 11 12 13 14 15 | .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME unload \- Unload machine code .SH SYNOPSIS \fBunload \fR?\fIswitches\fR? \fIfileName\fR .br | | | | | 9 10 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 '\" Note: do not modify the .SH NAME line immediately below! .SH NAME unload \- Unload machine code .SH SYNOPSIS \fBunload \fR?\fIswitches\fR? \fIfileName\fR .br \fBunload \fR?\fIswitches\fR? \fIfileName prefix\fR .br \fBunload \fR?\fIswitches\fR? \fIfileName prefix interp\fR .BE .SH DESCRIPTION .PP This command tries to unload shared libraries previously loaded with \fBload\fR from the application's address space. \fIfileName\fR is the name of the file containing the library file to be unload; it must be the same as the filename provided to \fBload\fR for loading the library. The \fIprefix\fR argument is the prefix (as determined by or passed to \fBload\fR), and is used to compute the name of the unload procedure; if not supplied, it is computed from \fIfileName\fR in the same manner as \fBload\fR. The \fIinterp\fR argument is the path name of the interpreter from which to unload the package (see the \fBinterp\fR manual entry for details); if \fIinterp\fR is omitted, it defaults to the interpreter in which the \fBunload\fR command was invoked. |
︙ | ︙ | |||
62 63 64 65 66 67 68 | call on the file), these counters track how many interpreters use the library. Each subsequent call to \fBload\fR after the first simply increments the proper reference count. .PP \fBunload\fR works in the opposite direction. As a first step, \fBunload\fR will check whether the library is unloadable: an unloadable library exports a special unload procedure. The name of the unload procedure is determined by | | | | | | | 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 | call on the file), these counters track how many interpreters use the library. Each subsequent call to \fBload\fR after the first simply increments the proper reference count. .PP \fBunload\fR works in the opposite direction. As a first step, \fBunload\fR will check whether the library is unloadable: an unloadable library exports a special unload procedure. The name of the unload procedure is determined by \fIprefix\fR and whether or not the target interpreter is a safe one. For normal interpreters the name of the initialization procedure will have the form \fIpfx\fB_Unload\fR, where \fIpfx\fR is the same as \fIprefix\fR except that the first letter is converted to upper case and all other letters are converted to lower case. For example, if \fIprefix\fR is \fBfoo\fR or \fBFOo\fR, the initialization procedure's name will be \fBFoo_Unload\fR. If the target interpreter is a safe interpreter, then the name of the initialization procedure will be \fIpkg\fB_SafeUnload\fR instead of \fIpkg\fB_Unload\fR. .PP If \fBunload\fR determines that a library is not unloadable (or unload functionality has been disabled during compilation), an error will be returned. If the library is unloadable, then \fBunload\fR will call the unload procedure. If the unload procedure returns \fBTCL_OK\fR, \fBunload\fR will proceed and decrease the proper reference count (depending on the target interpreter 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 |
︙ | ︙ | |||
110 111 112 113 114 115 116 | library is used only by the target interpreter and the library will be detached from the application as soon as the unload procedure returns, the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR. .SS NOTES .PP The \fBunload\fR command cannot unload libraries that are statically linked with the application. | | | | | | | > | | | | | | 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 | library is used only by the target interpreter and the library will be detached from the application as soon as the unload procedure returns, the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR. .SS NOTES .PP The \fBunload\fR command cannot unload libraries that are statically linked with the application. If \fIfileName\fR is an empty string, then the \fIprefix\fR argument 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 \fBtcl9\fR, and use any following wordchars but not digits, converted to titlecase as the prefix. For example, the command \fBunload libxyz4.2.so\fR uses the prefix \fBXyz\fR and the command \fBunload bin/last.so {}\fR uses the prefix \fBLast\fR. .SH "PORTABILITY ISSUES" .TP \fBUnix\fR\0\0\0\0\0 . Not all unix operating systems support library unloading. Under such an operating system \fBunload\fR returns an error (unless \fB\-nocomplain\fR has been specified). |
︙ | ︙ |
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 | \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 string(e.g., \fB"9.0.0"\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 |
︙ | ︙ |
Changes to doc/zipfs.n.
︙ | ︙ | |||
10 11 12 13 14 15 16 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME zipfs \- Mount and work with ZIP files within Tcl .SH SYNOPSIS .nf | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME zipfs \- Mount and work with ZIP files within Tcl .SH SYNOPSIS .nf \fBpackage require tcl::zipfs \fR?\fB1.0\fR? .sp \fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR? \fBzipfs exists\fR \fIfilename\fR \fBzipfs find\fR \fIdirectoryName\fR \fBzipfs info\fR \fIfilename\fR \fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR? \fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR? |
︙ | ︙ | |||
80 81 82 83 84 85 86 | .TP \fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR? . Return a list of all files in the mounted zipfs, or just those matching \fIpattern\fR (optionally controlled by the option parameters). The order of the names in the list is arbitrary. .TP | | | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | .TP \fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR? . Return a list of all files in the mounted zipfs, or just those matching \fIpattern\fR (optionally controlled by the option parameters). The order of the names in the list is arbitrary. .TP \fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR? . The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual filesystem at \fImountpoint\fR. After this command executes, files contained in \fIzipfile\fR will appear to Tcl to be regular files at the mount point. .RS .PP With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR. With |
︙ | ︙ | |||
142 143 144 145 146 147 148 149 150 151 152 153 154 155 | If the \fIinfile\fR parameter is specified, this file is prepended in front of the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\fR (i.e., the executable file of the running process) is used. If the \fIpassword\fR parameter is not empty, an obfuscated version of that password (see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the output file and the contents of the ZIP chunk are protected with that password. .PP If there is a file, \fBmain.tcl\fR, in the root directory of the resulting archive and the image file that the archive is attached to is a \fBtclsh\fR (or \fBwish\fR) instance (true by default, but depends on your configuration), then the resulting image is an executable that will \fBsource\fR the script in that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once that script has been executed. | > > | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | If the \fIinfile\fR parameter is specified, this file is prepended in front of the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\fR (i.e., the executable file of the running process) is used. If the \fIpassword\fR parameter is not empty, an obfuscated version of that password (see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the output file and the contents of the ZIP chunk are protected with that password. If the starting image has a ZIP archive already attached to it, it is removed from the copy in \fIoutfile\fR before the new ZIP archive is added. .PP If there is a file, \fBmain.tcl\fR, in the root directory of the resulting archive and the image file that the archive is attached to is a \fBtclsh\fR (or \fBwish\fR) instance (true by default, but depends on your configuration), then the resulting image is an executable that will \fBsource\fR the script in that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once that script has been executed. |
︙ | ︙ |
Changes to generic/regc_color.c.
1 2 3 4 | /* * colorings of characters * This file is #included by regcomp.c. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 | /* * colorings of characters * This file is #included by regcomp.c. * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ |
Changes to generic/regc_cvec.c.
1 2 3 4 | /* * Utility functions for handling cvecs * This file is #included by regcomp.c. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 | /* * Utility functions for handling cvecs * This file is #included by regcomp.c. * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ |
Changes to generic/regc_lex.c.
1 2 3 4 | /* * lexical analyzer * This file is #included by regcomp.c. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 | /* * lexical analyzer * This file is #included by regcomp.c. * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ | |||
423 424 425 426 427 428 429 | FAILW(REG_BADBR); } break; case CHR('\\'): /* BRE bound ends with \} */ if (INCON(L_BBND) && NEXT1('}')) { v->now++; INTOCON(L_BRE); | | | 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 | FAILW(REG_BADBR); } break; case CHR('\\'): /* BRE bound ends with \} */ if (INCON(L_BBND) && NEXT1('}')) { v->now++; INTOCON(L_BRE); RETV('}', 1); } else { FAILW(REG_BADBR); } break; default: FAILW(REG_BADBR); break; |
︙ | ︙ | |||
1001 1002 1003 1004 1005 1006 1007 | chr c = (chr)pc; switch (c) { case CHR('*'): if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) { RETV(PLAIN, c); } | | | 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 | chr c = (chr)pc; switch (c) { case CHR('*'): if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) { RETV(PLAIN, c); } RETV('*', 1); break; case CHR('['): if (HAVE(6) && *(v->now+0) == CHR('[') && *(v->now+1) == CHR(':') && (*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) && *(v->now+3) == CHR(':') && *(v->now+4) == CHR(']') && |
︙ | ︙ |
Changes to generic/regc_locale.c.
1 2 3 4 5 6 | /* * regc_locale.c -- * * This file contains the Unicode locale specific regexp routines. * This file is #included by regcomp.c. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * regc_locale.c -- * * This file contains the Unicode locale specific regexp routines. * This file is #included by regcomp.c. * * Copyright © 1998 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* ASCII character-name table */ |
︙ | ︙ |
Changes to generic/regc_nfa.c.
1 2 3 4 | /* * NFA utilities. * This file is #included by regcomp.c. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 | /* * NFA utilities. * This file is #included by regcomp.c. * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ |
Changes to generic/regcomp.c.
1 2 3 4 | /* * re_*comp and friends - compile REs * This file #includes several others (see the bottom). * | | | 1 2 3 4 5 6 7 8 9 10 11 12 | /* * re_*comp and friends - compile REs * This file #includes several others (see the bottom). * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ |
Changes to generic/rege_dfa.c.
1 2 3 4 | /* * DFA routines * This file is #included by regexec.c. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 | /* * DFA routines * This file is #included by regexec.c. * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ |
Changes to generic/regerror.c.
1 2 3 | /* * regerror - error-code expansion * | | | 1 2 3 4 5 6 7 8 9 10 11 | /* * regerror - error-code expansion * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ |
Changes to generic/regexec.c.
1 2 3 | /* * re_*exec and friends - match REs * | | | 1 2 3 4 5 6 7 8 9 10 11 | /* * re_*exec and friends - match REs * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ |
Changes to generic/regfree.c.
1 2 3 | /* * regfree - free an RE * | | | 1 2 3 4 5 6 7 8 9 10 11 | /* * regfree - free an RE * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ |
Changes to generic/regfronts.c.
1 2 3 4 5 6 | /* * regcomp and regexec - front ends to re_ routines * * Mostly for implementation of backward-compatibility kludges. Note that * these routines exist ONLY in char versions. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * regcomp and regexec - front ends to re_ routines * * Mostly for implementation of backward-compatibility kludges. Note that * these routines exist ONLY in char versions. * * Copyright © 1998, 1999 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ |
Changes to generic/tcl.decls.
1 2 3 4 5 6 7 | # tcl.decls -- # # This file contains the declarations for all supported public # functions that are exported by the Tcl library via the stubs table. # This file is used to generate the tclDecls.h, tclPlatDecls.h # and tclStubInit.c files. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # tcl.decls -- # # This file contains the declarations for all supported public # functions that are exported by the Tcl library via the stubs table. # This file is used to generate the tclDecls.h, tclPlatDecls.h # and tclStubInit.c files. # # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2001, 2002 Kevin B. Kenny. All rights reserved. # Copyright © 2007 Daniel A. Steffen <[email protected]> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. library tcl # Define the tcl interface with several sub interfaces: |
︙ | ︙ | |||
59 60 61 62 63 64 65 | const char *file, int line) } # Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix, # but they are part of the old generic interface, so we include them here for # compatibility reasons. | | | | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | const char *file, int line) } # Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix, # but they are part of the old generic interface, so we include them here for # compatibility reasons. declare 9 { void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, void *clientData) } declare 10 { void Tcl_DeleteFileHandler(int fd) } declare 11 { void Tcl_SetTimer(const Tcl_Time *timePtr) } declare 12 { void Tcl_Sleep(int ms) |
︙ | ︙ | |||
141 142 143 144 145 146 147 | 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 { | | | 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 | 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 *TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr) } 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) |
︙ | ︙ | |||
168 169 170 171 172 173 174 | declare 39 { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 { const Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { | | | 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | declare 39 { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 { const Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { char *TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) } declare 42 { void Tcl_InvalidateStringRep(Tcl_Obj *objPtr) } declare 43 { int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr) |
︙ | ︙ | |||
612 613 614 615 616 617 618 | declare 166 { Tcl_Obj *Tcl_GetObjResult(Tcl_Interp *interp) } # Tcl_GetOpenFile is only available on unix, but it is a part of the old # generic interface, so we include it here for compatibility reasons. | | | 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | declare 166 { Tcl_Obj *Tcl_GetObjResult(Tcl_Interp *interp) } # Tcl_GetOpenFile is only available on unix, but it is a part of the old # generic interface, so we include it here for compatibility reasons. declare 167 { int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr) } # Obsolete. Should now use Tcl_FSGetPathType which is objectified # and therefore usually faster. declare 168 { Tcl_PathType Tcl_GetPathType(const char *path) |
︙ | ︙ | |||
884 885 886 887 888 889 890 | } # Obsolete, use Tcl_FSSplitPath declare 243 { void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr) } # Removed in 9.0 (stub entry only) #declare 244 { | | | | 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 | } # Obsolete, use Tcl_FSSplitPath declare 243 { void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr) } # Removed in 9.0 (stub entry only) #declare 244 { # void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix, # Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc) #} # Removed in 9.0 (stub entry only) #declare 245 { # int Tcl_StringMatch(const char *str, const char *pattern) #} # Removed in 9.0: #declare 246 { |
︙ | ︙ | |||
1205 1206 1207 1208 1209 1210 1211 | declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { const char *Tcl_UtfAtIndex(const char *src, size_t index) } declare 326 { | | | | | 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 | declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { const char *Tcl_UtfAtIndex(const char *src, size_t index) } declare 326 { int TclUtfCharComplete(const char *src, size_t length) } declare 327 { size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) } declare 328 { const char *Tcl_UtfFindFirst(const char *src, int ch) } declare 329 { const char *Tcl_UtfFindLast(const char *src, int ch) } declare 330 { const char *TclUtfNext(const char *src) } declare 331 { const char *TclUtfPrev(const char *src, const char *start) } declare 332 { int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } |
︙ | ︙ | |||
1597 1598 1599 1600 1601 1602 1603 | # TIP#10 (thread-aware channels) akupries declare 433 { Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel) } # introduced in 8.4a3 declare 434 { | | | 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 | # TIP#10 (thread-aware channels) akupries declare 433 { Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel) } # introduced in 8.4a3 declare 434 { Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) } # TIP#15 (math function introspection) dkf # Removed in 9.0: #declare 435 { # int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, # int *numArgsPtr, Tcl_ValueType **argTypesPtr, |
︙ | ︙ | |||
1639 1640 1641 1642 1643 1644 1645 | 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, | | | | 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 | 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 { |
︙ | ︙ | |||
1809 1810 1811 1812 1813 1814 1815 | declare 489 { void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue) } declare 490 { Tcl_StatBuf *Tcl_AllocStatBuf(void) } declare 491 { | | | | 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 | declare 489 { void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue) } declare 490 { Tcl_StatBuf *Tcl_AllocStatBuf(void) } declare 491 { long long Tcl_Seek(Tcl_Channel chan, long long offset, int mode) } declare 492 { long long Tcl_Tell(Tcl_Channel chan) } # TIP#91 (back-compat enhancements for channels) dkf declare 493 { Tcl_DriverWideSeekProc *Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) } |
︙ | ︙ | |||
2084 2085 2086 2087 2088 2089 2090 | } declare 559 { int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value) } # TIP #208 ('chan' command) jeffh declare 560 { | | | 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 | } declare 559 { int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value) } # TIP #208 ('chan' command) jeffh declare 560 { int Tcl_TruncateChannel(Tcl_Channel chan, long long length) } declare 561 { Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) } # TIP#219 (channel reflection api) akupries |
︙ | ︙ | |||
2235 2236 2237 2238 2239 2240 2241 | declare 594 { int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr) } declare 595 { int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr) } declare 596 { | | | | | | | 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 | declare 594 { int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr) } declare 595 { int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr) } declare 596 { long long Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr) } declare 597 { long long Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr) } declare 598 { long long Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr) } declare 599 { unsigned long long Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr) } declare 600 { unsigned long long Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr) } declare 601 { unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr) } # TIP#314 (ensembles with parameters) dkf for Lars Hellstr"om declare 602 { |
︙ | ︙ | |||
2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 | char *Tcl_UniCharToUtfDString(const int *uniStr, size_t uniLength, Tcl_DString *dsPtr) } declare 648 { int *Tcl_UtfToUniCharDString(const char *src, size_t length, Tcl_DString *dsPtr) } # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## # Define the platform specific public Tcl interface. These functions are only # available on the designated platform. interface tclPlat ################################ # Unix specific functions # (none) | > > > > > > > > > > > > > > > > > > > > > > < < < < < < < < < < < < < < < < < < | > > > > > > > > > | | | | > > > | 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 | char *Tcl_UniCharToUtfDString(const int *uniStr, size_t uniLength, Tcl_DString *dsPtr) } declare 648 { int *Tcl_UtfToUniCharDString(const char *src, size_t length, Tcl_DString *dsPtr) } # TIP #481 declare 651 { char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) } declare 652 { Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) } declare 653 { unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) } # TIP #575 declare 654 { int Tcl_UtfCharComplete(const char *src, size_t length) } declare 655 { const char *Tcl_UtfNext(const char *src) } declare 656 { const char *Tcl_UtfPrev(const char *src, const char *start) } # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## # Define the platform specific public Tcl interface. These functions are only # available on the designated platform. interface tclPlat ################################ # Unix specific functions # (none) ################################ # Mac OS X specific functions declare 1 { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath) } declare 2 { void Tcl_MacOSXNotifierAddRunLoopMode(const void *runLoopMode) } ################################ # Windows specific functions declare 3 { void Tcl_WinConvertError(unsigned errCode) } ############################################################################## # Public functions that are not accessible via the stubs table. 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 { void Tcl_InitSubsystems(void) } export { int TclZipfs_AppHook(int *argc, char ***argv) } # Local Variables: # mode: tcl # End: |
Changes to generic/tcl.h.
︙ | ︙ | |||
41 42 43 44 45 46 47 | * unix/configure.ac (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.ac (as above) * win/tcl.m4 (not patchlevel) * README (sections 0 and 2, with and without separator) * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) | < | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | * unix/configure.ac (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.ac (as above) * win/tcl.m4 (not patchlevel) * README (sections 0 and 2, with and without separator) * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) */ #define TCL_MAJOR_VERSION 9 #define TCL_MINOR_VERSION 0 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE #define TCL_RELEASE_SERIAL 2 |
︙ | ︙ | |||
98 99 100 101 102 103 104 | * should, so also for their sake, we keep the #include to be consistent with * prior Tcl releases. */ #include <stdio.h> #if defined(__GNUC__) && (__GNUC__ > 2) | > > > | > | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | * should, so also for their sake, we keep the #include to be consistent with * prior Tcl releases. */ #include <stdio.h> #if defined(__GNUC__) && (__GNUC__ > 2) # if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__MINGW_PRINTF_FORMAT, a, b))) # else # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) # endif # define TCL_NORETURN __attribute__ ((noreturn)) # define TCL_NOINLINE __attribute__ ((noinline)) # define TCL_NORETURN1 __attribute__ ((noreturn)) #else # define TCL_FORMAT_PRINTF(a,b) # if defined(_MSC_VER) && (_MSC_VER >= 1310) # define TCL_NORETURN _declspec(noreturn) |
︙ | ︙ | |||
145 146 147 148 149 150 151 | * * Note: when building static but linking dynamically to MSVCRT we must still * correctly decorate the C library imported function. Use CRTIMPORT * for this purpose. _DLL is defined by the compiler when linking to * MSVCRT. */ | < | | 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | * * Note: when building static but linking dynamically to MSVCRT we must still * correctly decorate the C library imported function. Use CRTIMPORT * for this purpose. _DLL is defined by the compiler when linking to * MSVCRT. */ #ifdef _WIN32 # ifdef STATIC_BUILD # define DLLIMPORT # define DLLEXPORT # ifdef _DLL # define CRTIMPORT __declspec(dllimport) # else # define CRTIMPORT |
︙ | ︙ | |||
228 229 230 231 232 233 234 | /* * Darwin specific configure overrides (to support fat compiles, where * configure runs only once for multiple architectures): */ #ifdef __APPLE__ # ifdef __LP64__ | < < > > > > > > > < < < < | < < < < < < < < < | | | < | | > > > | > > > | 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 | /* * Darwin specific configure overrides (to support fat compiles, where * configure runs only once for multiple architectures): */ #ifdef __APPLE__ # ifdef __LP64__ # define TCL_WIDE_INT_IS_LONG 1 # define TCL_CFG_DO64BIT 1 # else /* !__LP64__ */ # undef TCL_WIDE_INT_IS_LONG # undef TCL_CFG_DO64BIT # endif /* __LP64__ */ # undef HAVE_STRUCT_STAT64 #endif /* __APPLE__ */ /* Cross-compiling 32-bit on a 64-bit platform? Then our * configure script does the wrong thing. Correct that here. */ #if defined(__GNUC__) && !defined(_WIN32) && !defined(__LP64__) # undef TCL_WIDE_INT_IS_LONG #endif /* * Define Tcl_WideInt to be a type that is (at least) 64-bits wide, and define * Tcl_WideUInt to be the unsigned variant of that type (assuming that where * we have one, we can have the other.) * * Also defines the following macros: * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on a * LP64 system such as modern Solaris or Linux ... not including Win64) * Tcl_WideAsLong - forgetful converter from wideInt to long. * Tcl_LongAsWide - sign-extending converter from long to wideInt. * Tcl_WideAsDouble - converter from wideInt to double. * Tcl_DoubleAsWide - converter from double to wideInt. * * The following invariant should hold for any long value 'longVal': * longVal == Tcl_WideAsLong(Tcl_LongAsWide(longVal)) */ #if !defined(TCL_WIDE_INT_TYPE) && !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__GNUC__) /* * Don't know what platform it is and configure hasn't discovered what is * going on for us. Try to guess... */ # include <limits.h> # if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX) # define TCL_WIDE_INT_IS_LONG 1 # endif #endif #ifndef TCL_WIDE_INT_TYPE # define TCL_WIDE_INT_TYPE long long #endif /* !TCL_WIDE_INT_TYPE */ typedef TCL_WIDE_INT_TYPE Tcl_WideInt; typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; #ifndef TCL_LL_MODIFIER # if defined(_WIN32) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO) # define TCL_LL_MODIFIER "I64" # else # define TCL_LL_MODIFIER "ll" # endif #endif /* !TCL_LL_MODIFIER */ #ifndef TCL_Z_MODIFIER # if defined(__GNUC__) && !defined(_WIN32) # define TCL_Z_MODIFIER "z" # elif defined(_WIN64) # define TCL_Z_MODIFIER TCL_LL_MODIFIER # else # define TCL_Z_MODIFIER "" # endif #endif /* !TCL_Z_MODIFIER */ #define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) #define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) #define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) |
︙ | ︙ | |||
553 554 555 556 557 558 559 | typedef void (Tcl_FreeProc) (void *blockPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); | | | | > > > > > | 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 | typedef void (Tcl_FreeProc) (void *blockPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp); typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (void *clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); typedef char * (Tcl_VarTraceProc) (void *clientData, Tcl_Interp *interp, const char *part1, const char *part2, int flags); typedef void (Tcl_CommandTraceProc) (void *clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, void *clientData); typedef void (Tcl_DeleteFileHandlerProc) (int fd); typedef void (Tcl_AlertNotifierProc) (void *clientData); typedef void (Tcl_ServiceModeHookProc) (int mode); typedef void *(Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); #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. */ |
︙ | ︙ | |||
798 799 800 801 802 803 804 | /* * Definition for a number of bytes of buffer space sufficient to hold the * string representation of an integer in base 10 (assuming the existence of * 64-bit integers). */ | | | 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 | /* * Definition for a number of bytes of buffer space sufficient to hold the * string representation of an integer in base 10 (assuming the existence of * 64-bit integers). */ #define TCL_INTEGER_SPACE (3*(int)sizeof(Tcl_WideInt)) /* * Flag values passed to Tcl_ConvertElement. * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to * use backslash quoting instead. * TCL_DONT_QUOTE_HASH disables the default quoting of the '#' character. It * is safe to leave the hash unquoted when the element is not the first |
︙ | ︙ | |||
929 930 931 932 933 934 935 | #define TCL_LINK_ULONG 12 #endif #define TCL_LINK_FLOAT 13 #define TCL_LINK_WIDE_UINT 14 #define TCL_LINK_CHARS 15 #define TCL_LINK_BINARY 16 #define TCL_LINK_READ_ONLY 0x80 | | | 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 | #define TCL_LINK_ULONG 12 #endif #define TCL_LINK_FLOAT 13 #define TCL_LINK_WIDE_UINT 14 #define TCL_LINK_CHARS 15 #define TCL_LINK_BINARY 16 #define TCL_LINK_READ_ONLY 0x80 /* *---------------------------------------------------------------------------- * Forward declarations of Tcl_HashTable and related types. */ #ifndef TCL_HASH_TYPE # define TCL_HASH_TYPE size_t |
︙ | ︙ | |||
1261 1262 1263 1264 1265 1266 1267 | Tcl_DString *dsPtr); typedef void (Tcl_DriverWatchProc) (void *instanceData, int mask); typedef int (Tcl_DriverGetHandleProc) (void *instanceData, int direction, void **handlePtr); typedef int (Tcl_DriverFlushProc) (void *instanceData); typedef int (Tcl_DriverHandlerProc) (void *instanceData, int interestMask); | | | | | 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 | Tcl_DString *dsPtr); typedef void (Tcl_DriverWatchProc) (void *instanceData, int mask); typedef int (Tcl_DriverGetHandleProc) (void *instanceData, int direction, void **handlePtr); typedef int (Tcl_DriverFlushProc) (void *instanceData); typedef int (Tcl_DriverHandlerProc) (void *instanceData, int interestMask); typedef long long (Tcl_DriverWideSeekProc) (void *instanceData, long long offset, int mode, int *errorCodePtr); /* * TIP #218, Channel Thread Actions */ typedef void (Tcl_DriverThreadActionProc) (void *instanceData, int action); /* * TIP #208, File Truncation (etc.) */ typedef int (Tcl_DriverTruncateProc) (void *instanceData, long long length); /* * struct Tcl_ChannelType: * * One such structure exists for each type (kind) of channel. It collects * together in one place all the functions that are part of the specific * channel type. |
︙ | ︙ | |||
2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 | * main library in case an extension is statically linked into an application. */ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact, int magic); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); #if defined(_WIN32) TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...); #else # define Tcl_ConsolePanic NULL #endif #ifdef USE_TCL_STUBS | > > | 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 | * main library in case an extension is statically linked into an application. */ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact, int magic); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); const char * TclInitStubTable(const char *version); void * TclStubCall(void *arg); #if defined(_WIN32) TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...); #else # define Tcl_ConsolePanic NULL #endif #ifdef USE_TCL_STUBS |
︙ | ︙ | |||
2175 2176 2177 2178 2179 2180 2181 | /* * Public functions that are not accessible via the stubs table. * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ | | | | > | | | | | > > > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 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 | /* * Public functions that are not accessible via the stubs table. * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp()))) EXTERN TCL_NORETURN 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_FindExecutable(const char *argv0); EXTERN const char * Tcl_SetPreInitScript(const char *string); EXTERN const char * Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *panicProc); EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); #ifndef TCL_NO_DEPRECATED # define Tcl_StaticPackage Tcl_StaticLibrary #endif EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); #ifdef _WIN32 EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv); #else EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #endif #if defined(_WIN32) && defined(UNICODE) #ifndef USE_TCL_STUBS # define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) #endif # define Tcl_MainEx Tcl_MainExW EXTERN TCL_NORETURN void Tcl_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif #ifdef USE_TCL_STUBS #define Tcl_SetPanicProc(panicProc) \ TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc)) #define Tcl_InitSubsystems() \ TclInitStubTable(((const char *(*)(void))TclStubCall((void *)1))()) #define Tcl_FindExecutable(argv0) \ TclInitStubTable(((const char *(*)(const char *))TclStubCall((void *)2))(argv0)) #define TclZipfs_AppHook(argcp, argvp) \ TclInitStubTable(((const char *(*)(int *, void *))TclStubCall((void *)3))(argcp, argvp)) #define Tcl_MainExW(argc, argv, appInitProc, interp) \ (void)((const char *(*)(int, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \ TclStubCall((void *)4))(argc, argv, appInitProc, interp) #if !defined(_WIN32) || !defined(UNICODE) #define Tcl_MainEx(argc, argv, appInitProc, interp) \ (void)((const char *(*)(int, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \ TclStubCall((void *)5))(argc, argv, appInitProc, interp) #endif #define Tcl_StaticLibrary(interp, pkgName, initProc, safeInitProc) \ (void)((const char *(*)(Tcl_Interp *, const char *, Tcl_LibraryInitProc *, Tcl_LibraryInitProc *)) \ TclStubCall((void *)6))(interp, pkgName, initProc, safeInitProc) #define Tcl_SetExitProc(proc) \ ((Tcl_ExitProc *(*)(Tcl_ExitProc *))TclStubCall((void *)7))(proc) #define Tcl_GetMemoryInfo(dsPtr) \ (void)((const char *(*)(Tcl_DString *))TclStubCall((void *)8))(dsPtr) #define Tcl_SetPreInitScript(string) \ ((const char *(*)(const char *))TclStubCall((void *)9))(string) #endif /* *---------------------------------------------------------------------------- * Include the public function declarations that are accessible via the stubs * table. */ #include "tclDecls.h" |
︙ | ︙ |
Changes to generic/tclAlloc.c.
1 2 3 4 5 6 7 8 | /* * tclAlloc.c -- * * This is a very fast storage allocator. It allocates blocks of a small * number of different sizes, and keeps free lists of each size. Blocks * that don't exactly fit are passed up to the next larger size. Blocks * over a certain size are directly allocated from the system. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * tclAlloc.c -- * * This is a very fast storage allocator. It allocates blocks of a small * number of different sizes, and keeps free lists of each size. Blocks * that don't exactly fit are passed up to the next larger size. Blocks * over a certain size are directly allocated from the system. * * Copyright © 1983 Regents of the University of California. * Copyright © 1996-1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ |
︙ | ︙ | |||
27 28 29 30 31 32 33 | #if defined(USE_TCLALLOC) && USE_TCLALLOC /* * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait * until Tcl uses config.h properly. */ | | | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | #if defined(USE_TCLALLOC) && USE_TCLALLOC /* * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait * until Tcl uses config.h properly. */ #if defined(_MSC_VER) || defined(__MSVCRT__) typedef size_t caddr_t; #endif /* * The overhead on a block is at least 8 bytes. When free, this space contains * a pointer to the next free block, and the bottom two bits must be zero. * When in use, the first byte is set to MAGIC, and the second byte is the |
︙ | ︙ | |||
90 91 92 93 94 95 96 | * nextf[i] is the pointer to the next free block of size 2^(i+3). The * smallest allocatable block is MINBLOCK bytes. The overhead information * precedes the data area returned to the user. */ #define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) #define NBUCKETS (13 - (MINBLOCK >> 4)) | | | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | * nextf[i] is the pointer to the next free block of size 2^(i+3). The * smallest allocatable block is MINBLOCK bytes. The overhead information * precedes the data area returned to the user. */ #define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) #define NBUCKETS (13 - (MINBLOCK >> 4)) #define MAXMALLOC ((size_t)1 << (NBUCKETS+2)) static union overhead *nextf[NBUCKETS]; /* * The following structure is used to keep track of all system memory * currently owned by Tcl. When finalizing, all this memory will be returned * to the system. */ |
︙ | ︙ | |||
578 579 580 581 582 583 584 | overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); return (void *)(overPtr+1); } | | | 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 | overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); return (void *)(overPtr+1); } maxSize = (size_t)1 << (i+3); expensive = 0; if (numBytes+OVERHEAD > maxSize) { expensive = 1; } else if (i>0 && numBytes+OVERHEAD < maxSize/2) { expensive = 1; } |
︙ | ︙ | |||
651 652 653 654 655 656 657 | Tcl_MutexLock(allocMutexPtr); fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s); for (i = 0; i < NBUCKETS; i++) { for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) { fprintf(stderr, " %u", j); } | | | | | 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 | Tcl_MutexLock(allocMutexPtr); fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s); for (i = 0; i < NBUCKETS; i++) { for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) { fprintf(stderr, " %u", j); } totalFree += ((size_t)j) * ((size_t)1 << (i + 3)); } fprintf(stderr, "\nused:\t"); for (i = 0; i < NBUCKETS; i++) { fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]); totalUsed += numMallocs[i] * ((size_t)1 << (i + 3)); } fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n", totalUsed, totalFree); fprintf(stderr, "\n\tNumber of big (>%" TCL_Z_MODIFIER "u) blocks in use: %" TCL_Z_MODIFIER "u\n", MAXMALLOC, numMallocs[NBUCKETS]); Tcl_MutexUnlock(allocMutexPtr); } #endif #else /* !USE_TCLALLOC */ |
︙ | ︙ | |||
745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 | void *oldPtr, /* Pointer to alloced block. */ size_t 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 * End: */ | > > | 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 | void *oldPtr, /* Pointer to alloced block. */ size_t 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 * End: */ |
Changes to generic/tclAssembly.c.
1 2 3 4 5 6 7 8 | /* * tclAssembly.c -- * * Assembler for Tcl bytecodes. * * This file contains the procedures that convert Tcl Assembly Language (TAL) * to a sequence of bytecode instructions for the Tcl execution engine. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclAssembly.c -- * * Assembler for Tcl bytecodes. * * This file contains the procedures that convert Tcl Assembly Language (TAL) * to a sequence of bytecode instructions for the Tcl execution engine. * * Copyright © 2010 Ozgur Dogan Ugurlu. * Copyright © 2010 Kevin B. Kenny. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /*- *- THINGS TO DO: |
︙ | ︙ | |||
883 884 885 886 887 888 889 | Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL); } /* * Set up the compilation environment, and assemble the code. */ | | | 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 | Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL); } /* * Set up the compilation environment, and assemble the code. */ source = Tcl_GetStringFromObj(objPtr, &sourceLen); TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0); status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT); if (status != TCL_OK) { /* * Assembly failed. Clean up and report the error. */ TclFreeCompileEnv(&compEnv); |
︙ | ︙ | |||
1307 1308 1309 1310 1311 1312 1313 | if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "value"); goto cleanup; } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } | | | 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 | if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "value"); goto cleanup; } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len); litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0); BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0); break; case ASSEM_1BYTE: if (parsePtr->numWords != 1) { Tcl_WrongNumArgs(interp, 1, &instNameObj, ""); |
︙ | ︙ | |||
1474 1475 1476 1477 1478 1479 1480 | if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { CompileEmbeddedScript(assemEnvPtr, tokenPtr+1, TalInstructionTable+tblIdx); } else if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } else { | | | 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 | if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { CompileEmbeddedScript(assemEnvPtr, tokenPtr+1, TalInstructionTable+tblIdx); } else if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } else { operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len); litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0); /* * Assumes that PUSH is the first slot! */ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0); |
︙ | ︙ | |||
2311 2312 2313 2314 2315 2316 2317 | const char* varNameStr; size_t varNameLen; int localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { return -1; } | | | 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 | const char* varNameStr; size_t varNameLen; int localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { return -1; } varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen); if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) { Tcl_DecrRefCount(varNameObj); return -1; } localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr); Tcl_DecrRefCount(varNameObj); if (localVar == -1) { |
︙ | ︙ |
Changes to generic/tclAsync.c.
1 2 3 4 5 6 7 | /* * tclAsync.c -- * * This file provides low-level support needed to invoke signal handlers * in a safe way. The code here doesn't actually handle signals, though. * This code is based on proposals made by Mark Diekhans and Don Libes. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclAsync.c -- * * This file provides low-level support needed to invoke signal handlers * in a safe way. The code here doesn't actually handle signals, though. * This code is based on proposals made by Mark Diekhans and Don Libes. * * Copyright © 1993 The Regents of the University of California. * Copyright © 1994 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclBasic.c.
1 2 3 4 5 6 7 | /* * tclBasic.c -- * * Contains the basic facilities for TCL command interpretation, * including interpreter creation and deletion, command creation and * deletion, and command/script execution. * | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | /* * tclBasic.c -- * * Contains the basic facilities for TCL command interpretation, * including interpreter creation and deletion, command creation and * deletion, and command/script execution. * * Copyright © 1987-1994 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * Copyright © 2001, 2002 Kevin B. Kenny. All rights reserved. * Copyright © 2007 Daniel A. Steffen <[email protected]> * Copyright © 2006-2008 Joe Mistachkin. All rights reserved. * Copyright © 2008 Miguel Sofer <[email protected]> * * 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 "tclOOInt.h" |
︙ | ︙ | |||
739 740 741 742 743 744 745 746 747 748 749 750 751 752 | iPtr->returnCode = TCL_OK; iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; /* TIP #268 */ #if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE) if (getenv("TCL_PKG_PREFER_LATEST") == NULL) { iPtr->packagePrefer = PKG_PREFER_STABLE; } else #endif | > > > > | 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 | iPtr->returnCode = TCL_OK; iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; #ifdef _WIN32 # define getenv(x) _wgetenv(L##x) /* On Windows, use _wgetenv below */ #endif /* TIP #268 */ #if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE) if (getenv("TCL_PKG_PREFER_LATEST") == NULL) { iPtr->packagePrefer = PKG_PREFER_STABLE; } else #endif |
︙ | ︙ | |||
1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 | /* * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor */ Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); if (TclTommath_Init(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetStringResult(interp)); } if (TclOOInit(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetStringResult(interp)); | > | 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 | /* * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor */ Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs); if (TclTommath_Init(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetStringResult(interp)); } if (TclOOInit(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetStringResult(interp)); |
︙ | ︙ | |||
3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 | * traces. */ cmdPtr->nsPtr->refCount++; if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* * Now delete these traces. */ tracePtr = cmdPtr->tracePtr; | > > | 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 | * traces. */ cmdPtr->nsPtr->refCount++; if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; /* Note that CallCommandTraces() never frees cmdPtr, that's * done just before Tcl_DeleteCommandFromToken() returns */ CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* * Now delete these traces. */ tracePtr = cmdPtr->tracePtr; |
︙ | ︙ | |||
3595 3596 3597 3598 3599 3600 3601 | flags &= ~TCL_TRACE_RENAME; } if (flags == 0) { return NULL; } } cmdPtr->flags |= CMD_TRACE_ACTIVE; | < | 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 | 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) { |
︙ | ︙ | |||
3653 3654 3655 3656 3657 3658 3659 | /* * Restore the variable's flags, remove the record of our active traces, * and then return. */ cmdPtr->flags &= ~CMD_TRACE_ACTIVE; | < | 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 | /* * 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; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
3950 3951 3952 3953 3954 3955 3956 | /* * Setup errorCode variables so that we can differentiate between * being canceled and unwound. */ if (iPtr->asyncCancelMsg != NULL) { | | | 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 | /* * Setup errorCode variables so that we can differentiate between * being canceled and unwound. */ if (iPtr->asyncCancelMsg != NULL) { message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length); } else { length = 0; } if (iPtr->flags & TCL_CANCEL_UNWIND) { id = "IUNWIND"; if (length == 0) { |
︙ | ︙ | |||
4049 4050 4051 4052 4053 4054 4055 | * cancellation request. Currently, clientData is ignored. If the * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not * allowed to catch the script cancellation because the evaluation stack * for the interp is completely unwound. */ if (resultObjPtr != NULL) { | | | 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 | * cancellation request. Currently, clientData is ignored. If the * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not * allowed to catch the script cancellation because the evaluation stack * for the interp is completely unwound. */ if (resultObjPtr != NULL) { result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length); cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { cancelInfo->result = NULL; cancelInfo->length = 0; } |
︙ | ︙ | |||
4548 4549 4550 4551 4552 4553 4554 | /* * If there was an error, a command string will be needed for the * error log: get it out of the itemPtr. The details depend on the * type. */ listPtr = Tcl_NewListObj(objc, objv); | | | 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 | /* * If there was an error, a command string will be needed for the * error log: get it out of the itemPtr. The details depend on the * type. */ listPtr = Tcl_NewListObj(objc, objv); cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen); Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(listPtr); } iPtr->flags &= ~ERR_ALREADY_LOGGED; return result; } |
︙ | ︙ | |||
4694 4695 4696 4697 4698 4699 4700 | int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int traceCode = TCL_OK; | | | 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 | int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int traceCode = TCL_OK; const char *command = Tcl_GetStringFromObj(commandPtr, &length); /* * Call trace functions. * Execute any command or execution traces. Note that we bump up the * command's reference count for the duration of the calling of the * traces so that the structure doesn't go away underneath our feet. */ |
︙ | ︙ | |||
4746 4747 4748 4749 4750 4751 4752 | Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; size_t length; | | | 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 | Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; size_t length; const char *command = Tcl_GetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_DYING)) { if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) { traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); } if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { |
︙ | ︙ | |||
5988 5989 5990 5991 5992 5993 5994 | assert(invoker == NULL); iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr); Tcl_IncrRefCount(objPtr); | | | 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 | assert(invoker == NULL); iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr); Tcl_IncrRefCount(objPtr); script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); TclDecrRefCount(objPtr); iPtr->scriptCLLocPtr = saveCLLocPtr; return result; } |
︙ | ︙ | |||
6019 6020 6021 6022 6023 6024 6025 | } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; size_t numSrcBytes; ProcessUnexpectedResult(interp, result); result = TCL_ERROR; | | | 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 | } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; size_t numSrcBytes; ProcessUnexpectedResult(interp, result); result = TCL_ERROR; script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); Tcl_LogCommandInfo(interp, script, script, numSrcBytes); } /* * We are returning to level 0, so should call TclResetCancellation. * Let us just unset the flags inline. */ |
︙ | ︙ | |||
6550 6551 6552 6553 6554 6555 6556 | void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { size_t length; | | | 6555 6556 6557 6558 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 | void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { size_t length; const char *message = Tcl_GetStringFromObj(objPtr, &length); Interp *iPtr = (Interp *) interp; Tcl_IncrRefCount(objPtr); /* * If we are just starting to log an error, errorInfo is initialized from * the error message in the interpreter's result. |
︙ | ︙ | |||
7134 7135 7136 7137 7138 7139 7140 | Tcl_WideInt l = *((const Tcl_WideInt *) ptr); if (l > 0) { goto unChanged; } else if (l == 0) { if (TclHasStringRep(objv[1])) { size_t numBytes; | | > > > > > > > > > | | 7139 7140 7141 7142 7143 7144 7145 7146 7147 7148 7149 7150 7151 7152 7153 7154 7155 7156 7157 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 7169 7170 7171 7172 7173 7174 | Tcl_WideInt l = *((const Tcl_WideInt *) ptr); if (l > 0) { goto unChanged; } else if (l == 0) { if (TclHasStringRep(objv[1])) { size_t numBytes; const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); while (numBytes) { if (*bytes == '-') { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); return TCL_OK; } bytes++; numBytes--; } } goto unChanged; } else if (l == WIDE_MIN) { if (sizeof(Tcl_WideInt) > sizeof(int64_t)) { Tcl_WideUInt ul = -(Tcl_WideUInt)WIDE_MIN; if (mp_init(&big) != MP_OKAY || mp_unpack(&big, 1, 1, sizeof(Tcl_WideInt), 0, 0, &ul) != MP_OKAY) { return TCL_ERROR; } if (mp_neg(&big, &big) != MP_OKAY) { return TCL_ERROR; } } else if (mp_init_i64(&big, l) != MP_OKAY) { return TCL_ERROR; } goto tooLarge; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l)); return TCL_OK; } |
︙ | ︙ |
Changes to generic/tclBinary.c.
1 2 3 4 5 6 | /* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in * command and the Tcl binary data object. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in * command and the Tcl binary data object. * * Copyright © 1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" |
︙ | ︙ | |||
487 488 489 490 491 492 493 | } return baPtr->bytes; } /* *---------------------------------------------------------------------- * | | > | | 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 | } return baPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_GetByteArrayFromObj/TclGetByteArrayFromObj -- * * Attempt to get the array of bytes from the Tcl object. If the object * is not already a ByteArray object, an attempt will be made to convert * it to one. * * Results: * Pointer to array of bytes representing the ByteArray object. * * Side effects: * Frees old internal rep. Allocates memory for new internal rep. * *---------------------------------------------------------------------- */ #undef Tcl_GetByteArrayFromObj unsigned char * TclGetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { size_t numBytes = 0; unsigned char *bytes = TclGetBytesFromObj(NULL, objPtr, &numBytes); |
︙ | ︙ | |||
527 528 529 530 531 532 533 | } /* Macro TclGetByteArrayFromObj passes NULL for lengthPtr as * a trick to get around changing size. */ if (lengthPtr) { if (numBytes > INT_MAX) { /* Caller asked for an int length, but true length is outside | | < < > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | } /* Macro TclGetByteArrayFromObj passes NULL for lengthPtr as * a trick to get around changing size. */ if (lengthPtr) { if (numBytes > INT_MAX) { /* Caller asked for an int length, but true length is outside * the int range. */ *lengthPtr = 0; return NULL; } else { *lengthPtr = (int) numBytes; } } return bytes; } unsigned char * Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ size_t *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { size_t numBytes = 0; unsigned char *bytes = TclGetBytesFromObj(NULL, objPtr, &numBytes); if (bytes == NULL) { ByteArray *baPtr; const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); assert(irPtr != NULL); baPtr = GET_BYTEARRAY(irPtr); bytes = baPtr->bytes; numBytes = baPtr->used; } if (lengthPtr) { *lengthPtr = numBytes; } return bytes; } /* *---------------------------------------------------------------------- * * Tcl_SetByteArrayLength -- * * This procedure changes the length of the byte array for this object. |
︙ | ︙ | |||
633 634 635 636 637 638 639 | if (TclHasIntRep(objPtr, &properByteArrayType)) { return TCL_OK; } if (TclHasIntRep(objPtr, &tclByteArrayType)) { return TCL_OK; } | | | 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 | if (TclHasIntRep(objPtr, &properByteArrayType)) { return TCL_OK; } if (TclHasIntRep(objPtr, &tclByteArrayType)) { return TCL_OK; } src = Tcl_GetStringFromObj(objPtr, &length); bad = length; srcEnd = src + length; byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length)); for (dst = byteArrayPtr->bytes; src < srcEnd; ) { src += TclUtfToUniChar(src, &ch); if ((bad == length) && (ch > 255)) { |
︙ | ︙ | |||
1025 1026 1027 1028 1029 1030 1031 | * of bytes in a single argument. */ if (arg >= objc) { goto badIndex; } if (count == BINARY_ALL) { | | | 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 | * of bytes in a single argument. */ if (arg >= objc) { goto badIndex; } if (count == BINARY_ALL) { (void)Tcl_GetByteArrayFromObj(objv[arg], &count); } else if (count == BINARY_NOCOUNT) { count = 1; } arg++; if (cmd == 'a' || cmd == 'A') { offset += count; } else if (cmd == 'b' || cmd == 'B') { |
︙ | ︙ | |||
1189 1190 1191 1192 1193 1194 1195 | } switch (cmd) { case 'a': case 'A': { char pad = (char) (cmd == 'a' ? '\0' : ' '); unsigned char *bytes; | | | | 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 | } switch (cmd) { case 'a': case 'A': { char pad = (char) (cmd == 'a' ? '\0' : ' '); unsigned char *bytes; bytes = Tcl_GetByteArrayFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } if (length >= count) { memcpy(cursor, bytes, count); } else { memcpy(cursor, bytes, length); memset(cursor + length, pad, count - length); } cursor += count; break; } case 'b': case 'B': { unsigned char *last; str = Tcl_GetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } last = cursor + ((count + 7) / 8); |
︙ | ︙ | |||
1271 1272 1273 1274 1275 1276 1277 | break; } case 'h': case 'H': { unsigned char *last; int c; | | | 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 | break; } case 'h': case 'H': { unsigned char *last; int c; str = Tcl_GetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } last = cursor + ((count + 1) / 2); |
︙ | ︙ | |||
1502 1503 1504 1505 1506 1507 1508 | if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "value formatString ?varName ...?"); return TCL_ERROR; } numberCachePtr = &numberCacheHash; Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); | | > | | 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 | if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "value formatString ?varName ...?"); return TCL_ERROR; } numberCachePtr = &numberCacheHash; Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); buffer = Tcl_GetByteArrayFromObj(objv[1], &length); format = TclGetString(objv[2]); arg = 3; offset = 0; while (*format != '\0') { str = format; flags = 0; if (!GetFormatSpec(&format, &cmd, &count, &flags)) { goto done; } switch (cmd) { case 'a': case 'A': case 'C': { unsigned char *src; if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_ALL) { |
︙ | ︙ | |||
1536 1537 1538 1539 1540 1541 1542 | } } src = buffer + offset; size = count; /* | > | | > > > > > > > | 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 | } } src = buffer + offset; size = count; /* * Apply C string semantics or trim trailing * nulls and spaces, if necessary. */ if (cmd == 'C') { for (i = 0; i < size; i++) { if (src[i] == '\0') { size = i; break; } } } else if (cmd == 'A') { while (size > 0) { if (src[size - 1] != '\0' && src[size - 1] != ' ') { break; } size--; } } |
︙ | ︙ | |||
2555 2556 2557 2558 2559 2560 2561 | if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "data"); return TCL_ERROR; } TclNewObj(resultObj); | | | 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 | if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "data"); return TCL_ERROR; } TclNewObj(resultObj); data = Tcl_GetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { *cursor++ = HexDigits[(data[offset] >> 4) & 0x0F]; *cursor++ = HexDigits[data[offset] & 0x0F]; } Tcl_SetObjResult(interp, resultObj); return TCL_OK; |
︙ | ︙ | |||
2617 2618 2619 2620 2621 2622 2623 | } } TclNewObj(resultObj); data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); if (data == NULL) { pure = 0; | | | 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 | } } TclNewObj(resultObj); data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); if (data == NULL) { pure = 0; data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count); } datastart = data; dataend = data + count; size = (count + 1) / 2; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { value = 0; |
︙ | ︙ | |||
2751 2752 2753 2754 2755 2756 2757 | } break; case OPT_WRAPCHAR: wrapchar = (const char *)TclGetBytesFromObj(NULL, objv[i + 1], &wrapcharlen); if (wrapchar == NULL) { purewrap = 0; | | | | 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 | } break; case OPT_WRAPCHAR: wrapchar = (const char *)TclGetBytesFromObj(NULL, objv[i + 1], &wrapcharlen); if (wrapchar == NULL) { purewrap = 0; wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen); } break; } } if (wrapcharlen == 0) { maxlen = 0; } TclNewObj(resultObj); data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { unsigned char *cursor = NULL; size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ if (maxlen > 0 && size > maxlen) { int adjusted = size + (wrapcharlen * (size / maxlen)); |
︙ | ︙ | |||
2872 2873 2874 2875 2876 2877 2878 | Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */ break; case OPT_WRAPCHAR: | | | 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 | Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */ break; case OPT_WRAPCHAR: wrapchar = (const unsigned char *) Tcl_GetStringFromObj( objv[i + 1], &wrapcharlen); { const unsigned char *p = wrapchar; size_t numBytes = wrapcharlen; while (numBytes) { switch (*p) { |
︙ | ︙ | |||
2914 2915 2916 2917 2918 2919 2920 | /* * Allocate the buffer. This is a little bit too long, but is "good * enough". */ TclNewObj(resultObj); offset = 0; | | | 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 | /* * Allocate the buffer. This is a little bit too long, but is "good * enough". */ TclNewObj(resultObj); offset = 0; data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); rawLength = (lineLength - 1) * 3 / 4; start = cursor = Tcl_SetByteArrayLength(resultObj, (lineLength + wrapcharlen) * ((count + (rawLength - 1)) / rawLength)); n = bits = 0; /* |
︙ | ︙ | |||
3014 3015 3016 3017 3018 3019 3020 | } } TclNewObj(resultObj); data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); if (data == NULL) { pure = 0; | | | 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 | } } TclNewObj(resultObj); data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); if (data == NULL) { pure = 0; data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count); } datastart = data; dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); lineLen = -1; |
︙ | ︙ | |||
3189 3190 3191 3192 3193 3194 3195 | } } TclNewObj(resultObj); data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); if (data == NULL) { pure = 0; | | | 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 | } } TclNewObj(resultObj); data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); if (data == NULL) { pure = 0; data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count); } datastart = data; dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { unsigned long value = 0; |
︙ | ︙ |
Changes to generic/tclCkalloc.c.
1 2 3 4 5 6 7 | /* * tclCkalloc.c -- * * Interface to malloc and free that provides support for debugging * problems involving overwritten, double freeing memory and loss of * memory. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclCkalloc.c -- * * Interface to malloc and free that provides support for debugging * problems involving overwritten, double freeing memory and loss of * memory. * * Copyright © 1991-1994 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * This code contributed by Karl Lehenbauer and Mark Diekhans */ |
︙ | ︙ |
Changes to generic/tclClock.c.
1 2 3 4 5 6 7 | /* * tclClock.c -- * * Contains the time and date related commands. This code is derived from * the time and date facilities of TclX, by Mark Diekhans and Karl * Lehenbauer. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclClock.c -- * * Contains the time and date related commands. This code is derived from * the time and date facilities of TclX, by Mark Diekhans and Karl * Lehenbauer. * * Copyright © 1991-1995 Karl Lehenbauer & Mark Diekhans. * Copyright © 1995 Sun Microsystems, Inc. * Copyright © 2004 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 | int ClockGetenvObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *varName; const char *varValue; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } | > > > > > > > > | | > > > | > > > > > | > > | 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 | int ClockGetenvObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { #ifdef _WIN32 const WCHAR *varName; const WCHAR *varValue; Tcl_DString ds; #else const char *varName; const char *varValue; #endif if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } #ifdef _WIN32 Tcl_DStringInit(&ds); varName = Tcl_UtfToWCharDString(TclGetString(objv[1]), -1, &ds); varValue = _wgetenv(varName); if (varValue == NULL) { Tcl_DStringFree(&ds); } else { Tcl_DStringSetLength(&ds, 0); Tcl_WCharToUtfDString(varValue, -1, &ds); Tcl_DStringResult(interp, &ds); } #else varName = TclGetString(objv[1]); varValue = getenv(varName); if (varValue != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1)); } #endif return TCL_OK; } /* *---------------------------------------------------------------------- * * ThreadSafeLocalTime -- |
︙ | ︙ | |||
1758 1759 1760 1761 1762 1763 1764 | Tcl_WrongNumArgs(interp, 1, objv, "?-switch?"); return TCL_ERROR; } switch (index) { case CLICKS_MILLIS: Tcl_GetTime(&now); | | | | 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 | Tcl_WrongNumArgs(interp, 1, objv, "?-switch?"); return TCL_ERROR; } switch (index) { case CLICKS_MILLIS: Tcl_GetTime(&now); clicks = (Tcl_WideInt)(unsigned long)now.sec * 1000 + now.usec / 1000; break; case CLICKS_NATIVE: #ifdef TCL_WIDE_CLICKS clicks = TclpGetWideClicks(); #else clicks = (Tcl_WideInt)TclpGetClicks(); #endif break; case CLICKS_MICROS: clicks = TclpGetMicroseconds(); break; } |
︙ | ︙ | |||
2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 | * None. * * Side effects: * Calls tzset. * *---------------------------------------------------------------------- */ static void TzsetIfNecessary(void) { | > > > > > > > > > | | > > > | > > > > > > > > > > > > > > | | | | | | | 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 | * None. * * Side effects: * Calls tzset. * *---------------------------------------------------------------------- */ #ifdef _WIN32 #define getenv(x) _wgetenv(L##x) #else #define WCHAR char #define wcslen strlen #define wcscmp strcmp #define wcscpy strcpy #endif static void TzsetIfNecessary(void) { static WCHAR* tzWas = (WCHAR *)INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ static long tzLastRefresh = 0; /* Used for latency before next refresh */ static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling, that TZ changed via TCL */ const WCHAR *tzIsNow; /* Current value of TZ */ /* * Prevent performance regression on some platforms by resolving of system time zone: * small latency for check whether environment was changed (once per second) * no latency if environment was changed with tcl-env (compare both epoch values) */ Tcl_Time now; Tcl_GetTime(&now); if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) { return; } tzEnvEpoch = TclEnvEpoch; tzLastRefresh = now.sec; Tcl_MutexLock(&clockMutex); tzIsNow = getenv("TZ"); if (tzIsNow != NULL && (tzWas == NULL || tzWas == (WCHAR *)INT2PTR(-1) || wcscmp(tzIsNow, tzWas) != 0)) { tzset(); if (tzWas != NULL && tzWas != (WCHAR *)INT2PTR(-1)) { Tcl_Free(tzWas); } tzWas = (WCHAR *)Tcl_Alloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1)); wcscpy(tzWas, tzIsNow); } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); if (tzWas != (WCHAR *)INT2PTR(-1)) Tcl_Free(tzWas); tzWas = NULL; } Tcl_MutexUnlock(&clockMutex); } /* *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
1 2 3 4 5 6 | /* * tclCmdAH.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters A to H. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclCmdAH.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters A to H. * * Copyright © 1987-1993 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef _WIN32 |
︙ | ︙ | |||
427 428 429 430 431 432 433 | Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data"); return TCL_ERROR; } /* * Convert the string into a byte array in 'ds' */ | | | 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 | Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data"); return TCL_ERROR; } /* * Convert the string into a byte array in 'ds' */ bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length); Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds); /* * Note that we cannot use Tcl_DStringResult here because it will * truncate the string at the first null byte. */ |
︙ | ︙ | |||
492 493 494 495 496 497 498 | return TCL_ERROR; } /* * Convert the string to a byte array in 'ds' */ | | | 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 | return TCL_ERROR; } /* * Convert the string to a byte array in 'ds' */ stringPtr = Tcl_GetStringFromObj(data, &length); Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds); Tcl_SetObjResult(interp, Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); /* |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
1 2 3 4 5 6 7 8 | /* * tclCmdIL.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters I through L. It * contains only commands in the generic core (i.e., those that don't * depend much upon UNIX facilities). * | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | /* * tclCmdIL.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters I through L. It * contains only commands in the generic core (i.e., those that don't * depend much upon UNIX facilities). * * Copyright © 1987-1993 The Regents of the University of California. * Copyright © 1993-1997 Lucent Technologies. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * Copyright © 2005 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclRegexp.h" |
︙ | ︙ | |||
541 542 543 544 545 546 547 | * bytecompiled - in that case, the return was a copy of the body's string * rep. In order to better isolate the implementation details of the * compiler/engine subsystem, we now always return a copy of the string * rep. It is important to return a copy so that later manipulations of * the object do not invalidate the internal rep. */ | | | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 | * bytecompiled - in that case, the return was a copy of the body's string * rep. In order to better isolate the implementation details of the * compiler/engine subsystem, we now always return a copy of the string * rep. It is important to return a copy so that later manipulations of * the object do not invalidate the internal rep. */ bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes); Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes)); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1695 1696 1697 1698 1699 1700 1701 | interpName = TclGetString(objv[1]); } if (objc < 3) { /* Get loaded files in all packages. */ packageName = NULL; } else { /* Get pkgs just in specified interp. */ packageName = TclGetString(objv[2]); } | | | 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 | interpName = TclGetString(objv[1]); } if (objc < 3) { /* Get loaded files in all packages. */ packageName = NULL; } else { /* Get pkgs just in specified interp. */ packageName = TclGetString(objv[2]); } return TclGetLoadedLibraries(interp, interpName, packageName); } /* *---------------------------------------------------------------------- * * InfoNameOfExecutableCmd -- * |
︙ | ︙ | |||
2208 2209 2210 2211 2212 2213 2214 | Tcl_SetObjResult(interp, elemPtrs[0]); return TCL_OK; } joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); | | | 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 | Tcl_SetObjResult(interp, elemPtrs[0]); return TCL_OK; } joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); (void) Tcl_GetStringFromObj(joinObjPtr, &length); if (length == 0) { resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { int i; resObjPtr = Tcl_NewObj(); for (i = 0; i < listLen; i++) { |
︙ | ︙ | |||
3535 3536 3537 3538 3539 3540 3541 | patObj = objv[objc - 1]; patternBytes = NULL; if (mode == EXACT || mode == SORTED) { switch ((enum datatypes) dataType) { case ASCII: case DICTIONARY: | | | 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 | patObj = objv[objc - 1]; patternBytes = NULL; if (mode == EXACT || mode == SORTED) { switch ((enum datatypes) dataType) { case ASCII: case DICTIONARY: patternBytes = Tcl_GetStringFromObj(patObj, &length); break; case INTEGER: result = TclGetWideIntFromObj(interp, patObj, &patWide); if (result != TCL_OK) { goto done; } |
︙ | ︙ | |||
3565 3566 3567 3568 3569 3570 3571 | * 1844789] */ TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv); break; } } else { | | | 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 | * 1844789] */ TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv); break; } } else { patternBytes = Tcl_GetStringFromObj(patObj, &length); } /* * Set default index value to -1, indicating failure; if we find the item * in the course of our search, index will be set to the correct value. */ |
︙ | ︙ | |||
3709 3710 3711 3712 3713 3714 3715 | } switch (mode) { case SORTED: case EXACT: switch ((enum datatypes) dataType) { case ASCII: | | | 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 | } switch (mode) { case SORTED: case EXACT: switch ((enum datatypes) dataType) { case ASCII: bytes = Tcl_GetStringFromObj(itemPtr, &elemLen); if (length == elemLen) { /* * This split allows for more optimal compilation of * memcmp/strcasecmp. */ if (noCase) { |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
1 2 3 4 5 6 7 8 | /* * tclCmdMZ.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters M to Z. It * contains only commands in the generic core (i.e. those that don't * depend much upon UNIX facilities). * | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclCmdMZ.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters M to Z. It * contains only commands in the generic core (i.e. those that don't * depend much upon UNIX facilities). * * Copyright © 1987-1993 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 1998-2000 Scriptics Corporation. * Copyright © 2002 ActiveState Corporation. * Copyright © 2003-2009 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
32 33 34 35 36 37 38 | /* * Default set of characters to trim in [string trim] and friends. This is a * UTF-8 literal string containing all Unicode space characters [TIP #413] */ const char tclDefaultTrimSet[] = | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 | /* * Default set of characters to trim in [string trim] and friends. This is a * UTF-8 literal string containing all Unicode space characters [TIP #413] */ const char tclDefaultTrimSet[] = "\x09\x0A\x0B\x0C\x0D " /* ASCII */ "\xC0\x80" /* nul (U+0000) */ "\xC2\x85" /* next line (U+0085) */ "\xC2\xA0" /* non-breaking space (U+00a0) */ "\xE1\x9A\x80" /* ogham space mark (U+1680) */ "\xE1\xA0\x8E" /* mongolian vowel separator (U+180e) */ "\xE2\x80\x80" /* en quad (U+2000) */ "\xE2\x80\x81" /* em quad (U+2001) */ "\xE2\x80\x82" /* en space (U+2002) */ "\xE2\x80\x83" /* em space (U+2003) */ "\xE2\x80\x84" /* three-per-em space (U+2004) */ "\xE2\x80\x85" /* four-per-em space (U+2005) */ "\xE2\x80\x86" /* six-per-em space (U+2006) */ "\xE2\x80\x87" /* figure space (U+2007) */ "\xE2\x80\x88" /* punctuation space (U+2008) */ "\xE2\x80\x89" /* thin space (U+2009) */ "\xE2\x80\x8A" /* hair space (U+200a) */ "\xE2\x80\x8B" /* zero width space (U+200b) */ "\xE2\x80\xA8" /* line separator (U+2028) */ "\xE2\x80\xA9" /* paragraph separator (U+2029) */ "\xE2\x80\xAF" /* narrow no-break space (U+202f) */ "\xE2\x81\x9F" /* medium mathematical space (U+205f) */ "\xE2\x81\xA0" /* word joiner (U+2060) */ "\xE3\x80\x80" /* ideographic space (U+3000) */ "\xEF\xBB\xBF" /* zero width no-break space (U+feff) */ ; /* *---------------------------------------------------------------------- * * Tcl_PwdObjCmd -- * |
︙ | ︙ | |||
604 605 606 607 608 609 610 | int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp; | | | | | 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 | int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp; wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen); wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen); wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen); wend = wstring + wlen - (slen ? slen - 1 : 0); result = TCL_OK; if (slen == 0) { /* * regsub behavior for "" matches between each character. 'string * map' skips the "" case. |
︙ | ︙ | |||
696 697 698 699 700 701 702 | */ if (objv[1] == objv[0]) { objPtr = Tcl_DuplicateObj(objv[1]); } else { objPtr = objv[1]; } | | | | 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 | */ if (objv[1] == objv[0]) { objPtr = Tcl_DuplicateObj(objv[1]); } else { objPtr = objv[1]; } wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); if (objv[2] == objv[0]) { subPtr = Tcl_DuplicateObj(objv[2]); } else { subPtr = objv[2]; } if (!command) { wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); } result = TCL_OK; /* * The following loop is to handle multiple matches within the same source * string; each iteration handles one match and its corresponding |
︙ | ︙ | |||
823 824 825 826 827 828 829 | Tcl_ResetResult(interp); /* * Refetch the unicode, in case the representation was smashed by * the user code. */ | | | 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 | Tcl_ResetResult(interp); /* * Refetch the unicode, in case the representation was smashed by * the user code. */ wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); offset += end; if (end == 0 || start == end) { /* * Always consume at least one character of the input string * in order to prevent infinite loops, even when we * technically matched the empty string; we must not match |
︙ | ︙ | |||
1183 1184 1185 1186 1187 1188 1189 | size_t splitCharLen, stringLen; Tcl_Obj *listPtr, *objPtr; if (objc == 2) { splitChars = " \n\t\r"; splitCharLen = 4; } else if (objc == 3) { | | | | 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 | size_t splitCharLen, stringLen; Tcl_Obj *listPtr, *objPtr; if (objc == 2) { splitChars = " \n\t\r"; splitCharLen = 4; } else if (objc == 3) { splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?"); return TCL_ERROR; } stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen); end = stringPtr + stringLen; listPtr = Tcl_NewObj(); if (stringLen == 0) { /* * Do nothing. */ |
︙ | ︙ | |||
1615 1616 1617 1618 1619 1620 1621 | case STR_IS_TRUE: case STR_IS_FALSE: if (!TclHasIntRep(objPtr, &tclBooleanType) && (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) { if (strict) { result = 0; } else { | | | 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 | case STR_IS_TRUE: case STR_IS_FALSE: if (!TclHasIntRep(objPtr, &tclBooleanType) && (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) { if (strict) { result = 0; } else { string1 = Tcl_GetStringFromObj(objPtr, &length1); result = length1 == 0; } } else if ((objPtr->internalRep.wideValue != 0) ? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) { result = 0; } break; |
︙ | ︙ | |||
1644 1645 1646 1647 1648 1649 1650 | */ const char *elemStart, *nextElem; int lenRemain; size_t elemSize; const char *p; | | | 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 | */ const char *elemStart, *nextElem; int lenRemain; size_t elemSize; const char *p; string1 = Tcl_GetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; p=nextElem, lenRemain=end-nextElem) { if (TCL_ERROR == TclFindElement(NULL, p, lenRemain, &elemStart, &nextElem, &elemSize, NULL)) { Tcl_Obj *tmpStr; |
︙ | ︙ | |||
1684 1685 1686 1687 1688 1689 1690 | break; case STR_IS_DOUBLE: { if (TclHasIntRep(objPtr, &tclDoubleType) || TclHasIntRep(objPtr, &tclIntType) || TclHasIntRep(objPtr, &tclBignumType)) { break; } | | | 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 | break; case STR_IS_DOUBLE: { if (TclHasIntRep(objPtr, &tclDoubleType) || TclHasIntRep(objPtr, &tclIntType) || TclHasIntRep(objPtr, &tclBignumType)) { break; } string1 = Tcl_GetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } goto str_is_done; } end = string1 + length1; |
︙ | ︙ | |||
1714 1715 1716 1717 1718 1719 1720 | break; case STR_IS_INT: case STR_IS_ENTIER: if (TclHasIntRep(objPtr, &tclIntType) || TclHasIntRep(objPtr, &tclBignumType)) { break; } | | | 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 | break; case STR_IS_INT: case STR_IS_ENTIER: if (TclHasIntRep(objPtr, &tclIntType) || TclHasIntRep(objPtr, &tclBignumType)) { break; } string1 = Tcl_GetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } goto str_is_done; } end = string1 + length1; |
︙ | ︙ | |||
1756 1757 1758 1759 1760 1761 1762 | } break; case STR_IS_WIDE: if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) { break; } | | | 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 | } break; case STR_IS_WIDE: if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) { break; } string1 = Tcl_GetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } goto str_is_done; } result = 0; |
︙ | ︙ | |||
1825 1826 1827 1828 1829 1830 1831 | */ const char *elemStart, *nextElem; size_t lenRemain; size_t elemSize; const char *p; | | | 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 | */ const char *elemStart, *nextElem; size_t lenRemain; size_t elemSize; const char *p; string1 = Tcl_GetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; p=nextElem, lenRemain=end-nextElem) { if (TCL_ERROR == TclFindElement(NULL, p, lenRemain, &elemStart, &nextElem, &elemSize, NULL)) { Tcl_Obj *tmpStr; |
︙ | ︙ | |||
1880 1881 1882 1883 1884 1885 1886 | break; case STR_IS_XDIGIT: chcomp = UniCharIsHexDigit; break; } if (chcomp != NULL) { | | | 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 | break; case STR_IS_XDIGIT: chcomp = UniCharIsHexDigit; break; } if (chcomp != NULL) { string1 = Tcl_GetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } goto str_is_done; } end = string1 + length1; |
︙ | ︙ | |||
1966 1967 1968 1969 1970 1971 1972 | if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); return TCL_ERROR; } if (objc == 4) { | | | 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 | if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); return TCL_ERROR; } if (objc == 4) { const char *string = Tcl_GetStringFromObj(objv[1], &length2); if ((length2 > 1) && strncmp(string, "-nocase", length2) == 0) { nocase = 1; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": must be -nocase", string)); |
︙ | ︙ | |||
2058 2059 2060 2061 2062 2063 2064 | if (objv[objc-2] == objv[objc-1]) { sourceObj = Tcl_DuplicateObj(objv[objc-1]); copySource = 1; } else { sourceObj = objv[objc-1]; } | | | 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 | if (objv[objc-2] == objv[objc-1]) { sourceObj = Tcl_DuplicateObj(objv[objc-1]); copySource = 1; } else { sourceObj = objv[objc-1]; } ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1); if (length1 == 0) { /* * Empty input string, just stop now. */ goto done; } |
︙ | ︙ | |||
2088 2089 2090 2091 2092 2093 2094 | * larger strings. */ size_t mapLen; int u2lc; Tcl_UniChar *mapString; | | | | 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 | * larger strings. */ size_t mapLen; int u2lc; Tcl_UniChar *mapString; ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); p = ustring1; if ((length2 > length1) || (length2 == 0)) { /* * Match string is either longer than input or empty. */ ustring1 = end; } else { mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen); u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, length2) == 0)) { if (p != ustring1) { |
︙ | ︙ | |||
2134 2135 2136 2137 2138 2139 2140 | mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2); mapLens = (size_t *)TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2); if (nocase) { u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int)); } for (index = 0; index < mapElemc; index++) { | | | 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 | mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2); mapLens = (size_t *)TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2); if (nocase) { u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int)); } for (index = 0; index < mapElemc; index++) { mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index], mapLens+index); if (nocase && ((index % 2) == 0)) { u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]); } } for (p = ustring1; ustring1 < end; ustring1++) { for (index = 0; index < mapElemc; index += 2) { |
︙ | ︙ | |||
2238 2239 2240 2241 2242 2243 2244 | if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string"); return TCL_ERROR; } if (objc == 4) { size_t length; | | | 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 | if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string"); return TCL_ERROR; } if (objc == 4) { size_t length; const char *string = Tcl_GetStringFromObj(objv[1], &length); if ((length > 1) && strncmp(string, "-nocase", length) == 0) { nocase = TCL_MATCH_NOCASE; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": must be -nocase", string)); |
︙ | ︙ | |||
2501 2502 2503 2504 2505 2506 2507 | StringStartCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; | | | | < | < | | | | | | | | 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 | StringStartCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; const Tcl_UniChar *p, *string; size_t cur, index, length; Tcl_Obj *obj; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; } string = Tcl_GetUnicodeFromObj(objv[1], &length); if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } if (index + 1 >= length + 1) { index = length - 1; } cur = 0; if (index + 1 > 1) { p = &string[index]; (void)TclUniCharToUCS4(p, &ch); for (cur = index; cur != TCL_INDEX_NONE; cur--) { int delta = 0; const Tcl_UniChar *next; if (!Tcl_UniCharIsWordChar(ch)) { break; } next = TclUCS4Prev(p, string); do { next += delta; delta = TclUniCharToUCS4(next, &ch); } while (next + delta < p); p = next; } if (cur != index) { cur += 1; } } |
︙ | ︙ | |||
2573 2574 2575 2576 2577 2578 2579 | StringEndCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; | | | | < | < | | | | | 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 | StringEndCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; const Tcl_UniChar *p, *end, *string; size_t cur, index, length; Tcl_Obj *obj; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; } string = Tcl_GetUnicodeFromObj(objv[1], &length); if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } if (index == TCL_INDEX_NONE) { index = TCL_INDEX_START; } if (index + 1 <= length + 1) { p = &string[index]; end = string+length; for (cur = index; p < end; cur++) { p += TclUniCharToUCS4(p, &ch); if (!Tcl_UniCharIsWordChar(ch)) { break; } } if (cur == index) { cur++; } } else { cur = length; } TclNewIndexObj(obj, cur); Tcl_SetObjResult(interp, obj); return TCL_OK; } /* |
︙ | ︙ | |||
2654 2655 2656 2657 2658 2659 2660 | str_cmp_args: Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? ?-length int? string1 string2"); return TCL_ERROR; } for (i = 1; i < objc-2; i++) { | | | 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 | str_cmp_args: Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? ?-length int? string1 string2"); return TCL_ERROR; } for (i = 1; i < objc-2; i++) { string2 = Tcl_GetStringFromObj(objv[i], &length); if ((length > 1) && !strncmp(string2, "-nocase", length)) { nocase = 1; } else if ((length > 1) && !strncmp(string2, "-length", length)) { if (i+1 >= objc-2) { goto str_cmp_args; } |
︙ | ︙ | |||
2753 2754 2755 2756 2757 2758 2759 | str_cmp_args: Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? ?-length int? string1 string2"); return TCL_ERROR; } for (i = 1; i < objc-2; i++) { | | | 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 | str_cmp_args: Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? ?-length int? string1 string2"); return TCL_ERROR; } for (i = 1; i < objc-2; i++) { string = Tcl_GetStringFromObj(objv[i], &length); if ((length > 1) && !strncmp(string, "-nocase", length)) { *nocase = 1; } else if ((length > 1) && !strncmp(string, "-length", length)) { if (i+1 >= objc-2) { goto str_cmp_args; } |
︙ | ︙ | |||
2854 2855 2856 2857 2858 2859 2860 | size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } | | | 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 | size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } (void) Tcl_GetStringFromObj(objv[1], &length); Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length)); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2927 2928 2929 2930 2931 2932 2933 | char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } | | | 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 | char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); length1 = Tcl_UtfToLower(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); |
︙ | ︙ | |||
2962 2963 2964 2965 2966 2967 2968 | last = length1; } if (last + 1 < first + 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } | | | 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 | last = length1; } if (last + 1 < first + 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = Tcl_GetStringFromObj(objv[1], &length1); start = Tcl_UtfAtIndex(string1, first); end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); length2 = Tcl_UtfToLower(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); |
︙ | ︙ | |||
3012 3013 3014 3015 3016 3017 3018 | char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } | | | 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 | char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); length1 = Tcl_UtfToUpper(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); |
︙ | ︙ | |||
3047 3048 3049 3050 3051 3052 3053 | last = length1; } if (last + 1 < first + 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } | | | 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 | last = length1; } if (last + 1 < first + 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = Tcl_GetStringFromObj(objv[1], &length1); start = Tcl_UtfAtIndex(string1, first); end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); length2 = Tcl_UtfToUpper(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); |
︙ | ︙ | |||
3097 3098 3099 3100 3101 3102 3103 | char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } | | | 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 | char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); length1 = Tcl_UtfToTitle(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); |
︙ | ︙ | |||
3132 3133 3134 3135 3136 3137 3138 | last = length1; } if (last + 1 < first + 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } | | | 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 | last = length1; } if (last + 1 < first + 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = Tcl_GetStringFromObj(objv[1], &length1); start = Tcl_UtfAtIndex(string1, first); end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); length2 = Tcl_UtfToTitle(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); |
︙ | ︙ | |||
3177 3178 3179 3180 3181 3182 3183 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; size_t triml, trimr, length1, length2; if (objc == 3) { | | | | 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; size_t triml, trimr, length1, length2; if (objc == 3) { string2 = Tcl_GetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[1], &length1); triml = TclTrim(string1, length1, string2, length2, &trimr); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1 + triml, length1 - triml - trimr)); return TCL_OK; } |
︙ | ︙ | |||
3225 3226 3227 3228 3229 3230 3231 | Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim; size_t length1, length2; if (objc == 3) { | | | | 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 | Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim; size_t length1, length2; if (objc == 3) { string2 = Tcl_GetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[1], &length1); trim = TclTrimLeft(string1, length1, string2, length2); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim)); return TCL_OK; } |
︙ | ︙ | |||
3272 3273 3274 3275 3276 3277 3278 | Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim; size_t length1, length2; if (objc == 3) { | | | | 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 | Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim; size_t length1, length2; if (objc == 3) { string2 = Tcl_GetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[1], &length1); trim = TclTrimRight(string1, length1, string2, length2); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim)); return TCL_OK; } |
︙ | ︙ | |||
3693 3694 3695 3696 3697 3698 3699 | } for (i = 0; i < objc; i += 2) { /* * See if the pattern matches the string. */ | | | 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 | } for (i = 0; i < objc; i += 2) { /* * See if the pattern matches the string. */ pattern = Tcl_GetStringFromObj(objv[i], &patternLength); if ((i == objc - 2) && (*pattern == 'd') && (strcmp(pattern, "default") == 0)) { Tcl_Obj *emptyObj = NULL; /* * If either indexVarObj or matchVarObj are non-NULL, we're in |
︙ | ︙ |
Changes to generic/tclCompCmds.c.
1 2 3 4 5 6 | /* * tclCompCmds.c -- * * This file contains compilation procedures that compile various Tcl * commands into a sequence of instructions ("bytecodes"). * | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclCompCmds.c -- * * This file contains compilation procedures that compile various Tcl * commands into a sequence of instructions ("bytecodes"). * * Copyright © 1997-1998 Sun Microsystems, Inc. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * Copyright © 2002 ActiveState Corporation. * Copyright © 2004-2013 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
892 893 894 895 896 897 898 | const char *bytes; int len; size_t slen; Tcl_ListObjGetElements(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); | | | 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 | const char *bytes; int len; size_t slen; Tcl_ListObjGetElements(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); bytes = Tcl_GetStringFromObj(objPtr, &slen); PushLiteral(envPtr, bytes, slen); Tcl_DecrRefCount(objPtr); return TCL_OK; } /* * General case: runtime concat. |
︙ | ︙ | |||
1329 1330 1331 1332 1333 1334 1335 | Tcl_DecrRefCount(valueObj); } /* * We did! Excellent. The "verifyDict" is to do type forcing. */ | | | 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 | Tcl_DecrRefCount(valueObj); } /* * We did! Excellent. The "verifyDict" is to do type forcing. */ bytes = Tcl_GetStringFromObj(dictObj, &len); PushLiteral(envPtr, bytes, len); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_DICT_VERIFY, envPtr); Tcl_DecrRefCount(dictObj); return TCL_OK; /* |
︙ | ︙ | |||
2769 2770 2771 2772 2773 2774 2775 | Tcl_Obj *varNameObj; const char *bytes; int varIndex; size_t length; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); | | | 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 | Tcl_Obj *varNameObj; const char *bytes; int varIndex; size_t length; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); bytes = Tcl_GetStringFromObj(varNameObj, &length); varIndex = LocalScalar(bytes, length, envPtr); if (varIndex < 0) { code = TCL_ERROR; goto done; } varListPtr->varIndexes[j] = varIndex; } |
︙ | ︙ | |||
3206 3207 3208 3209 3210 3211 3212 | } /* * Not an error, always a constant result, so just push the result as a * literal. Job done. */ | | | 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 | } /* * Not an error, always a constant result, so just push the result as a * literal. Job done. */ bytes = Tcl_GetStringFromObj(tmpObj, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(tmpObj); return TCL_OK; checkForStringConcatCase: /* * See if we can generate a sequence of things to concatenate. This |
︙ | ︙ | |||
3277 3278 3279 3280 3281 3282 3283 | * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { Tcl_AppendToObj(tmpObj, start, bytes - start); if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { | | | 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 | * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { Tcl_AppendToObj(tmpObj, start, bytes - start); if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { const char *b = Tcl_GetStringFromObj(tmpObj, &len); /* * If there is a non-empty literal from the format string, * push it and reset. */ if (len > 0) { |
︙ | ︙ | |||
3311 3312 3313 3314 3315 3316 3317 | } /* * Handle the case of a trailing literal. */ Tcl_AppendToObj(tmpObj, start, bytes - start); | | | 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 | } /* * Handle the case of a trailing literal. */ Tcl_AppendToObj(tmpObj, start, bytes - start); bytes = Tcl_GetStringFromObj(tmpObj, &len); if (len > 0) { PushLiteral(envPtr, bytes, len); i++; } Tcl_DecrRefCount(tmpObj); Tcl_DecrRefCount(formatObj); |
︙ | ︙ |
Changes to generic/tclCompCmdsGR.c.
1 2 3 4 5 6 7 | /* * tclCompCmdsGR.c -- * * This file contains compilation procedures that compile various Tcl * commands (beginning with the letters 'g' through 'r') into a sequence * of instructions ("bytecodes"). * | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * tclCompCmdsGR.c -- * * This file contains compilation procedures that compile various Tcl * commands (beginning with the letters 'g' through 'r') into a sequence * of instructions ("bytecodes"). * * Copyright © 1997-1998 Sun Microsystems, Inc. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * Copyright © 2002 ActiveState Corporation. * Copyright © 2004-2013 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
2300 2301 2302 2303 2304 2305 2306 | } /* * Next, higher-level checks. Is the RE a very simple glob? Is the * replacement "simple"? */ | | | 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 | } /* * Next, higher-level checks. Is the RE a very simple glob? Is the * replacement "simple"? */ bytes = Tcl_GetStringFromObj(patternObj, &len); if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified) != TCL_OK || exact || quantified) { goto done; } bytes = Tcl_DStringValue(&pattern); if (*bytes++ != '*') { goto done; |
︙ | ︙ | |||
2348 2349 2350 2351 2352 2353 2354 | /* * Proved the simplicity constraints! Time to issue the code. */ result = TCL_OK; bytes = Tcl_DStringValue(&pattern) + 1; PushLiteral(envPtr, bytes, len); | | | 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 | /* * Proved the simplicity constraints! Time to issue the code. */ result = TCL_OK; bytes = Tcl_DStringValue(&pattern) + 1; PushLiteral(envPtr, bytes, len); bytes = Tcl_GetStringFromObj(replacementObj, &len); PushLiteral(envPtr, bytes, len); CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords - 2); TclEmitOpcode( INST_STR_MAP, envPtr); done: Tcl_DStringFree(&pattern); if (patternObj) { |
︙ | ︙ | |||
2606 2607 2608 2609 2610 2611 2612 | void TclCompileSyntaxError( Tcl_Interp *interp, CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); size_t numBytes; | | | 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 | void TclCompileSyntaxError( Tcl_Interp *interp, CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); size_t numBytes; const char *bytes = Tcl_GetStringFromObj(msg, &numBytes); TclErrorStackResetIf(interp, bytes, numBytes); TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr); CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0, TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR))); Tcl_ResetResult(interp); } |
︙ | ︙ | |||
2864 2865 2866 2867 2868 2869 2870 | if (lastTokenPtr->type != TCL_TOKEN_TEXT) { Tcl_DecrRefCount(tailPtr); return -1; } Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size); } | | | 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 | if (lastTokenPtr->type != TCL_TOKEN_TEXT) { Tcl_DecrRefCount(tailPtr); return -1; } Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size); } tailName = Tcl_GetStringFromObj(tailPtr, &len); if (len) { if (*(tailName + len - 1) == ')') { /* * Possible array: bail out */ |
︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
1 2 3 4 5 6 7 8 | /* * tclCompCmdsSZ.c -- * * This file contains compilation procedures that compile various Tcl * commands (beginning with the letters 's' through 'z', except for * [upvar] and [variable]) into a sequence of instructions ("bytecodes"). * Also includes the operator command compilers. * | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclCompCmdsSZ.c -- * * This file contains compilation procedures that compile various Tcl * commands (beginning with the letters 's' through 'z', except for * [upvar] and [variable]) into a sequence of instructions ("bytecodes"). * Also includes the operator command compilers. * * Copyright © 1997-1998 Sun Microsystems, Inc. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * Copyright © 2002 ActiveState Corporation. * Copyright © 2004-2010 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
249 250 251 252 253 254 255 | } else { folded = obj; } } else { Tcl_DecrRefCount(obj); if (folded) { size_t len; | | | | 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 | } else { folded = obj; } } else { Tcl_DecrRefCount(obj); if (folded) { size_t len; const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(folded); folded = NULL; numArgs ++; } CompileWord(envPtr, wordTokenPtr, interp, i); numArgs ++; if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */ TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr); numArgs = 1; /* concat pushes 1 obj, the result */ } } wordTokenPtr = TokenAfter(wordTokenPtr); } if (folded) { size_t len; const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(folded); folded = NULL; numArgs ++; } if (numArgs > 1) { |
︙ | ︙ | |||
947 948 949 950 951 952 953 | /* * Now issue the opcodes. Note that in the case that we know that the * first word is an empty word, we don't issue the map at all. That is the * correct semantics for mapping. */ | | | | 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 | /* * Now issue the opcodes. Note that in the case that we know that the * first word is an empty word, we don't issue the map at all. That is the * correct semantics for mapping. */ bytes = Tcl_GetStringFromObj(objv[0], &slen); if (slen == 0) { CompileWord(envPtr, stringTokenPtr, interp, 2); } else { PushLiteral(envPtr, bytes, slen); bytes = Tcl_GetStringFromObj(objv[1], &slen); PushLiteral(envPtr, bytes, slen); CompileWord(envPtr, stringTokenPtr, interp, 2); OP(STR_MAP); } Tcl_DecrRefCount(mapObj); return TCL_OK; } |
︙ | ︙ | |||
2910 2911 2912 2913 2914 2915 2916 | if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK || (objc > 2)) { TclDecrRefCount(tmpObj); goto failedToCompile; } if (objc > 0) { size_t len; | | | | 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 | if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK || (objc > 2)) { TclDecrRefCount(tmpObj); goto failedToCompile; } if (objc > 0) { size_t len; const char *varname = Tcl_GetStringFromObj(objv[0], &len); resultVarIndices[i] = LocalScalar(varname, len, envPtr); if (resultVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } } else { resultVarIndices[i] = -1; } if (objc == 2) { size_t len; const char *varname = Tcl_GetStringFromObj(objv[1], &len); optionVarIndices[i] = LocalScalar(varname, len, envPtr); if (optionVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } } else { |
︙ | ︙ | |||
3126 3127 3128 3129 3130 3131 3132 | */ LOAD( optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); | | | 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 | */ LOAD( optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); p = Tcl_GetStringFromObj(matchClauses[i], &slen); PushLiteral(envPtr, p, slen); OP( STR_EQ); JUMP4( JUMP_FALSE, notECJumpSource); } else { notECJumpSource = -1; } OP( POP); |
︙ | ︙ | |||
3338 3339 3340 3341 3342 3343 3344 | */ LOAD( optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); | | | 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 | */ LOAD( optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); p = Tcl_GetStringFromObj(matchClauses[i], &slen); PushLiteral(envPtr, p, slen); OP( STR_EQ); JUMP4( JUMP_FALSE, notECJumpSource); } else { notECJumpSource = -1; } OP( POP); |
︙ | ︙ | |||
3666 3667 3668 3669 3670 3671 3672 | } return TCL_ERROR; } if (varCount == 0) { const char *bytes; size_t len; | | | 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 | } return TCL_ERROR; } if (varCount == 0) { const char *bytes; size_t len; bytes = Tcl_GetStringFromObj(leadingWord, &len); if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) { flags = 0; haveFlags++; } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) { haveFlags++; } else { varCount++; |
︙ | ︙ |
Changes to generic/tclCompExpr.c.
︙ | ︙ | |||
160 161 162 163 164 165 166 167 168 169 170 171 172 173 | #define BAREWORD 3 /* Ambigous. Resolves to BOOLEAN or to * FUNCTION or a parse error according to * context and value. */ #define INCOMPLETE 4 /* A parse error. Used only when the single * "=" is encountered. */ #define INVALID 5 /* A parse error. Used when any punctuation * appears that's not a supported operator. */ /* Leaf lexemes */ #define NUMBER (LEAF | 1) /* For literal numbers */ #define SCRIPT (LEAF | 2) /* Script substitution; [foo] */ | > > | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | #define BAREWORD 3 /* Ambigous. Resolves to BOOLEAN or to * FUNCTION or a parse error according to * context and value. */ #define INCOMPLETE 4 /* A parse error. Used only when the single * "=" is encountered. */ #define INVALID 5 /* A parse error. Used when any punctuation * appears that's not a supported operator. */ #define COMMENT 6 /* Comment. Lasts to end of line or end of * expression, whichever comes first. */ /* Leaf lexemes */ #define NUMBER (LEAF | 1) /* For literal numbers */ #define SCRIPT (LEAF | 2) /* Script substitution; [foo] */ |
︙ | ︙ | |||
458 459 460 461 462 463 464 | INVALID /* DC4 */, INVALID /* NAK */, INVALID /* SYN */, INVALID /* ETB */, INVALID /* CAN */, INVALID /* EM */, INVALID /* SUB */, INVALID /* ESC */, INVALID /* FS */, INVALID /* GS */, INVALID /* RS */, INVALID /* US */, INVALID /* SPACE */, 0 /* ! or != */, | | | 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 | INVALID /* DC4 */, INVALID /* NAK */, INVALID /* SYN */, INVALID /* ETB */, INVALID /* CAN */, INVALID /* EM */, INVALID /* SUB */, INVALID /* ESC */, INVALID /* FS */, INVALID /* GS */, INVALID /* RS */, INVALID /* US */, INVALID /* SPACE */, 0 /* ! or != */, QUOTED /* " */, 0 /* # */, VARIABLE /* $ */, MOD /* % */, 0 /* & or && */, INVALID /* ' */, OPEN_PAREN /* ( */, CLOSE_PAREN /* ) */, 0 /* * or ** */, PLUS /* + */, COMMA /* , */, MINUS /* - */, 0 /* . */, DIVIDE /* / */, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0-9 */ |
︙ | ︙ | |||
670 671 672 673 674 675 676 | */ if (nodesUsed >= nodesAvailable) { unsigned int size = nodesUsed * 2; OpNode *newPtr = NULL; do { | | > | | | 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 | */ if (nodesUsed >= nodesAvailable) { unsigned int size = nodesUsed * 2; OpNode *newPtr = NULL; do { if (size <= UINT_MAX/sizeof(OpNode)) { newPtr = (OpNode *) Tcl_AttemptRealloc(nodes, size * sizeof(OpNode)); } } while ((newPtr == NULL) && ((size -= (size - nodesUsed) / 2) > nodesUsed)); if (newPtr == NULL) { TclNewLiteralStringObj(msg, "not enough memory to parse expression"); errCode = "NOMEM"; goto error; |
︙ | ︙ | |||
704 705 706 707 708 709 710 711 712 713 714 715 716 717 | * Use context to categorize the lexemes that are ambiguous. */ if ((NODE_TYPE & lexeme) == 0) { int b; switch (lexeme) { case INVALID: msg = Tcl_ObjPrintf("invalid character \"%.*s\"", (int)scanned, start); errCode = "BADCHAR"; goto error; case INCOMPLETE: msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"", | > > > > | 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 | * Use context to categorize the lexemes that are ambiguous. */ if ((NODE_TYPE & lexeme) == 0) { int b; switch (lexeme) { case COMMENT: start += scanned; numBytes -= scanned; continue; case INVALID: msg = Tcl_ObjPrintf("invalid character \"%.*s\"", (int)scanned, start); errCode = "BADCHAR"; goto error; case INCOMPLETE: msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"", |
︙ | ︙ | |||
738 739 740 741 742 743 744 745 746 747 748 749 750 751 | * names we've parsed in the order we found them. */ Tcl_ListObjAppendElement(NULL, funcList, literal); } else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) { lexeme = BOOLEAN; } else { Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "..."); post = Tcl_ObjPrintf( "should be \"$%.*s%s\" or \"{%.*s%s}\"", (scanned < limit) ? (int)scanned : (int)limit - 3, | > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | * names we've parsed in the order we found them. */ Tcl_ListObjAppendElement(NULL, funcList, literal); } else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) { lexeme = BOOLEAN; } else { /* * Tricky case: see test expr-62.10 */ int scanned2 = scanned; do { scanned2 += TclParseAllWhiteSpace( start + scanned2, numBytes - scanned2); scanned2 += ParseLexeme( start + scanned2, numBytes - scanned2, &lexeme, NULL); } while (lexeme == COMMENT); if (lexeme == OPEN_PAREN) { /* * Actually a function call, but with obscuring * comments. Skip to the start of the parentheses. * Note that we assume that open parentheses are one * byte long. */ lexeme = FUNCTION; Tcl_ListObjAppendElement(NULL, funcList, literal); scanned = scanned2 - 1; break; } Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "..."); post = Tcl_ObjPrintf( "should be \"$%.*s%s\" or \"{%.*s%s}\"", (scanned < limit) ? (int)scanned : (int)limit - 3, |
︙ | ︙ | |||
1890 1891 1892 1893 1894 1895 1896 | size_t numBytes, /* Number of bytes in string. */ unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this storage, if non-NULL. */ { const char *end; | | > > > > > > > > > > > > > | 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 | size_t numBytes, /* Number of bytes in string. */ unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this storage, if non-NULL. */ { const char *end; int ch; Tcl_Obj *literal = NULL; unsigned char byte; if (numBytes == 0) { *lexemePtr = END; return 0; } byte = UCHAR(*start); if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) { *lexemePtr = Lexeme[byte]; return 1; } switch (byte) { case '#': { /* * Scan forward over the comment contents. */ size_t size; for (size = 0; byte != '\n' && byte != 0 && size < numBytes; size++) { byte = UCHAR(start[size]); } *lexemePtr = COMMENT; return size - (byte == '\n'); } case '*': if ((numBytes > 1) && (start[1] == '*')) { *lexemePtr = EXPON; return 2; } *lexemePtr = MULT; return 1; |
︙ | ︙ | |||
2099 2100 2101 2102 2103 2104 2105 | * Might be inspired by reserved identifier rules in C, which of course * have no direct relevance here. */ if (!TclIsBareword(*start) || *start == '_') { size_t scanned; if (Tcl_UtfCharComplete(start, numBytes)) { | | | | | 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 | * Might be inspired by reserved identifier rules in C, which of course * have no direct relevance here. */ if (!TclIsBareword(*start) || *start == '_') { size_t scanned; if (Tcl_UtfCharComplete(start, numBytes)) { scanned = TclUtfToUCS4(start, &ch); } else { char utfBytes[8]; memcpy(utfBytes, start, numBytes); utfBytes[numBytes] = '\0'; scanned = TclUtfToUCS4(utfBytes, &ch); } *lexemePtr = INVALID; Tcl_DecrRefCount(literal); return scanned; } end = start; while (numBytes && TclIsBareword(*end)) { |
︙ | ︙ | |||
2302 2303 2304 2305 2306 2307 2308 | case FUNCTION: { Tcl_DString cmdName; const char *p; size_t length; Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); | | | 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 | case FUNCTION: { Tcl_DString cmdName; const char *p; size_t length; Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); p = Tcl_GetStringFromObj(*funcObjv, &length); funcObjv++; Tcl_DStringAppend(&cmdName, p, length); TclEmitPush(TclRegisterLiteral(envPtr, Tcl_DStringValue(&cmdName), Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr); Tcl_DStringFree(&cmdName); |
︙ | ︙ | |||
2458 2459 2460 2461 2462 2463 2464 | break; case OT_LITERAL: { Tcl_Obj *const *litObjv = *litObjvPtr; Tcl_Obj *literal = *litObjv; if (optimize) { size_t length; | | | 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 | break; case OT_LITERAL: { Tcl_Obj *const *litObjv = *litObjvPtr; Tcl_Obj *literal = *litObjv; if (optimize) { size_t length; const char *bytes = Tcl_GetStringFromObj(literal, &length); int idx = TclRegisterLiteral(envPtr, bytes, length, 0); Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx); if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) { /* * Would like to do this: * |
︙ | ︙ | |||
2518 2519 2520 2521 2522 2523 2524 | * already, then use it to share via the literal table. */ if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; size_t numBytes; const char *bytes | | | 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 | * already, then use it to share via the literal table. */ if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; size_t numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0); tableValue = TclFetchLiteral(envPtr, idx); if ((tableValue->typePtr == NULL) && (objPtr->typePtr != NULL)) { /* * Same intrep surgery as for OT_LITERAL. |
︙ | ︙ |
Changes to generic/tclCompile.c.
1 2 3 4 5 6 7 | /* * tclCompile.c -- * * This file contains procedures that compile Tcl commands or parts of * commands (like quoted strings or nested sub-commands) into a sequence * of instructions ("bytecodes"). * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclCompile.c -- * * This file contains procedures that compile Tcl commands or parts of * commands (like quoted strings or nested sub-commands) into a sequence * of instructions ("bytecodes"). * * Copyright © 1996-1998 Sun Microsystems, Inc. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
781 782 783 784 785 786 787 | &tclTraceCompile, TCL_LINK_INT) != TCL_OK) { Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable"); } traceInitialized = 1; } #endif | | | 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 | &tclTraceCompile, TCL_LINK_INT) != TCL_OK) { Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable"); } traceInitialized = 1; } #endif stringPtr = Tcl_GetStringFromObj(objPtr, &length); /* * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and * use to initialize the tracking in the compiler. This information was * stored by TclCompEvalObj and ProcCompileProc. */ |
︙ | ︙ | |||
1319 1320 1321 1322 1323 1324 1325 | Tcl_StoreIntRep(objPtr, &substCodeType, NULL); codePtr = NULL; } } if (codePtr == NULL) { CompileEnv compEnv; size_t numBytes; | | | 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 | Tcl_StoreIntRep(objPtr, &substCodeType, NULL); codePtr = NULL; } } if (codePtr == NULL) { CompileEnv compEnv; size_t numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); /* TODO: Check for more TIP 280 */ TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0); TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv); TclEmitOpcode(INST_DONE, &compEnv); |
︙ | ︙ | |||
1808 1809 1810 1811 1812 1813 1814 | size_t length; cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } | | | 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 | size_t length; cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } bytes = Tcl_GetStringFromObj(cmdObj, &length); cmdLitIdx = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags); if (cmdPtr && TclRoutineHasName(cmdPtr)) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); } TclEmitPush(cmdLitIdx, envPtr); } |
︙ | ︙ | |||
2780 2781 2782 2783 2784 2785 2786 | * * 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 intrep. */ size_t numBytes; | | | 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 | * * 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 intrep. */ size_t numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); Tcl_IncrRefCount(copyPtr); TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr); envPtr->literalArrayPtr[i].objPtr = copyPtr; } |
︙ | ︙ | |||
3017 3018 3019 3020 3021 3022 3023 | if (!cachePtr || !name) { return -1; } varNamePtr = &cachePtr->varName0; for (i=0; i < cachePtr->numVars; varNamePtr++, i++) { if (*varNamePtr) { | | | 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 | if (!cachePtr || !name) { return -1; } varNamePtr = &cachePtr->varName0; for (i=0; i < cachePtr->numVars; varNamePtr++, i++) { if (*varNamePtr) { localName = Tcl_GetStringFromObj(*varNamePtr, &len); if ((len == nameBytes) && !strncmp(name, localName, len)) { return i; } } } return -1; } |
︙ | ︙ |
Changes to generic/tclConfig.c.
1 2 3 4 5 6 | /* * tclConfig.c -- * * This file provides the facilities which allow Tcl and other packages * to embed configuration information into their binary libraries. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclConfig.c -- * * This file provides the facilities which allow Tcl and other packages * to embed configuration information into their binary libraries. * * Copyright © 2002 Andreas Kupries <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
174 175 176 177 178 179 180 | /* *---------------------------------------------------------------------- * * QueryConfigObjCmd -- * * Implementation of "::<package>::pkgconfig", the command to query | | | 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 | /* *---------------------------------------------------------------------- * * QueryConfigObjCmd -- * * Implementation of "::<package>::pkgconfig", the command to query * configuration information embedded into a library. * * Results: * A standard tcl result. * * Side effects: * See the manual for what this command does. * |
︙ | ︙ | |||
255 256 257 258 259 260 261 | return TCL_ERROR; } } /* * Value is stored as-is in a byte array, see Bug [9b2e636361], * so we have to decode it first. */ | | | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 | return TCL_ERROR; } } /* * Value is stored as-is in a byte array, see Bug [9b2e636361], * so we have to decode it first. */ value = (const char *) Tcl_GetByteArrayFromObj(val, &n); value = Tcl_ExternalToUtfDString(venc, value, n, &conv); Tcl_SetObjResult(interp, Tcl_NewStringObj(value, Tcl_DStringLength(&conv))); Tcl_DStringFree(&conv); return TCL_OK; case CFG_LIST: |
︙ | ︙ |
Changes to generic/tclDate.c.
︙ | ︙ | |||
72 73 74 75 76 77 78 | /* * tclDate.c -- * * This file is generated from a yacc grammar defined in the file * tclGetDate.y. It should not be edited directly. * | | | 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | /* * tclDate.c -- * * This file is generated from a yacc grammar defined in the file * tclGetDate.y. It should not be edited directly. * * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans. * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
68 69 70 71 72 73 74 | EXTERN void * Tcl_DbCkalloc(size_t size, const char *file, int line); /* 7 */ EXTERN void Tcl_DbCkfree(void *ptr, const char *file, int line); /* 8 */ EXTERN void * Tcl_DbCkrealloc(void *ptr, size_t size, const char *file, int line); | < < < < < < < < < < < < < | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | EXTERN void * Tcl_DbCkalloc(size_t size, const char *file, int line); /* 7 */ EXTERN void Tcl_DbCkfree(void *ptr, const char *file, int line); /* 8 */ EXTERN void * Tcl_DbCkrealloc(void *ptr, size_t size, const char *file, int line); /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 10 */ EXTERN void Tcl_DeleteFileHandler(int fd); /* 11 */ EXTERN void Tcl_SetTimer(const Tcl_Time *timePtr); /* 12 */ EXTERN void Tcl_Sleep(int ms); /* 13 */ EXTERN int Tcl_WaitForEvent(const Tcl_Time *timePtr); /* 14 */ |
︙ | ︙ | |||
141 142 143 144 145 146 147 | /* 31 */ 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 */ | | | | 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 | /* 31 */ 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 * TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 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); /* Slot 36 is reserved */ /* 37 */ EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr); /* 38 */ EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 39 */ EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 40 */ EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 42 */ EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); /* 43 */ EXTERN int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 44 */ EXTERN int Tcl_ListObjAppendElement(Tcl_Interp *interp, |
︙ | ︙ | |||
485 486 487 488 489 490 491 | Tcl_Interp *childInterp); /* 164 */ EXTERN Tcl_Interp * Tcl_GetParent(Tcl_Interp *interp); /* 165 */ EXTERN const char * Tcl_GetNameOfExecutable(void); /* 166 */ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); | < < < < < < < < | 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 | Tcl_Interp *childInterp); /* 164 */ EXTERN Tcl_Interp * Tcl_GetParent(Tcl_Interp *interp); /* 165 */ EXTERN const char * Tcl_GetNameOfExecutable(void); /* 166 */ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 168 */ EXTERN Tcl_PathType Tcl_GetPathType(const char *path); /* 169 */ EXTERN size_t Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); /* 170 */ EXTERN size_t Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 171 */ |
︙ | ︙ | |||
876 877 878 879 880 881 882 | /* 323 */ EXTERN int Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ EXTERN const char * Tcl_UtfAtIndex(const char *src, size_t index); /* 326 */ | | | | | 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 | /* 323 */ EXTERN int Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ EXTERN const char * Tcl_UtfAtIndex(const char *src, size_t index); /* 326 */ EXTERN int TclUtfCharComplete(const char *src, size_t length); /* 327 */ EXTERN size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); /* 328 */ EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch); /* 329 */ EXTERN const char * Tcl_UtfFindLast(const char *src, int ch); /* 330 */ EXTERN const char * TclUtfNext(const char *src); /* 331 */ EXTERN const char * TclUtfPrev(const char *src, const char *start); /* 332 */ EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); |
︙ | ︙ | |||
1143 1144 1145 1146 1147 1148 1149 | const char *file, int line); /* 432 */ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, size_t length); /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ | | < | 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 | const char *file, int line); /* 432 */ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, size_t length); /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* Slot 435 is reserved */ /* Slot 436 is reserved */ /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 438 */ EXTERN int Tcl_DetachChannel(Tcl_Interp *interp, |
︙ | ︙ | |||
1168 1169 1170 1171 1172 1173 1174 | /* 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, | | | | 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 | /* 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 */ |
︙ | ︙ | |||
1294 1295 1296 1297 1298 1299 1300 | EXTERN Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue); /* 489 */ EXTERN void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 490 */ EXTERN Tcl_StatBuf * Tcl_AllocStatBuf(void); /* 491 */ | | | | 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 | EXTERN Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue); /* 489 */ EXTERN void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 490 */ EXTERN Tcl_StatBuf * Tcl_AllocStatBuf(void); /* 491 */ EXTERN long long Tcl_Seek(Tcl_Channel chan, long long offset, int mode); /* 492 */ EXTERN long long Tcl_Tell(Tcl_Channel chan); /* 493 */ EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr); /* 494 */ EXTERN int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 495 */ |
︙ | ︙ | |||
1494 1495 1496 1497 1498 1499 1500 | EXTERN int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */ EXTERN int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 560 */ EXTERN int Tcl_TruncateChannel(Tcl_Channel chan, | | | 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 | EXTERN int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */ EXTERN int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 560 */ EXTERN int Tcl_TruncateChannel(Tcl_Channel chan, long long length); /* 561 */ EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr); /* 562 */ EXTERN void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj *msg); /* 563 */ |
︙ | ︙ | |||
1597 1598 1599 1600 1601 1602 1603 | /* 593 */ EXTERN int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr); /* 594 */ EXTERN int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr); /* 595 */ EXTERN int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr); /* 596 */ | | | | | | | 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 | /* 593 */ EXTERN int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr); /* 594 */ EXTERN int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr); /* 595 */ EXTERN int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr); /* 596 */ EXTERN long long Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr); /* 597 */ EXTERN long long Tcl_GetModificationTimeFromStat( const Tcl_StatBuf *statPtr); /* 598 */ EXTERN long long Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr); /* 599 */ EXTERN unsigned long long Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr); /* 600 */ EXTERN unsigned long long Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr); /* 601 */ EXTERN unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr); /* 602 */ EXTERN int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 603 */ EXTERN int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, |
︙ | ︙ | |||
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 | EXTERN int Tcl_UtfToUniChar(const char *src, int *chPtr); /* 647 */ EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 648 */ EXTERN int * Tcl_UtfToUniCharDString(const char *src, size_t length, Tcl_DString *dsPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; typedef struct TclStubs { int magic; const TclStubHooks *hooks; int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ void * (*tcl_Alloc) (size_t size); /* 3 */ void (*tcl_Free) (void *ptr); /* 4 */ void * (*tcl_Realloc) (void *ptr, size_t size); /* 5 */ void * (*tcl_DbCkalloc) (size_t size, const char *file, int line); /* 6 */ void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */ void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */ | > > > > > > > > > > > > > > > > > < < < < < < < < < < < < < < < < | 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 | EXTERN int Tcl_UtfToUniChar(const char *src, int *chPtr); /* 647 */ EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 648 */ EXTERN int * Tcl_UtfToUniCharDString(const char *src, size_t length, Tcl_DString *dsPtr); /* Slot 649 is reserved */ /* Slot 650 is reserved */ /* 651 */ EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr); /* 653 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lengthPtr); /* 654 */ EXTERN int Tcl_UtfCharComplete(const char *src, size_t length); /* 655 */ EXTERN const char * Tcl_UtfNext(const char *src); /* 656 */ EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; typedef struct TclStubs { int magic; const TclStubHooks *hooks; int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ void * (*tcl_Alloc) (size_t size); /* 3 */ void (*tcl_Free) (void *ptr); /* 4 */ void * (*tcl_Realloc) (void *ptr, size_t size); /* 5 */ void * (*tcl_DbCkalloc) (size_t size, const char *file, int line); /* 6 */ void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */ void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */ void (*tcl_Sleep) (int ms); /* 12 */ int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */ int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */ void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */ void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 16 */ Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */ |
︙ | ︙ | |||
1807 1808 1809 1810 1811 1812 1813 | void (*reserved26)(void); Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */ Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, size_t 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 */ | | | | 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 | void (*reserved26)(void); Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */ Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, size_t 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 * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 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 */ void (*reserved36)(void); int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, 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 */ |
︙ | ︙ | |||
1941 1942 1943 1944 1945 1946 1947 | const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ const char * (*tcl_GetHostName) (void); /* 162 */ int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *childInterp); /* 163 */ Tcl_Interp * (*tcl_GetParent) (Tcl_Interp *interp); /* 164 */ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ | < < < < < < < < | 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 | const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ const char * (*tcl_GetHostName) (void); /* 162 */ int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *childInterp); /* 163 */ Tcl_Interp * (*tcl_GetParent) (Tcl_Interp *interp); /* 164 */ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */ Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */ size_t (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ size_t (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */ int (*tcl_GetServiceMode) (void); /* 171 */ Tcl_Interp * (*tcl_GetChild) (Tcl_Interp *interp, const char *name); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */ void (*reserved174)(void); |
︙ | ︙ | |||
2108 2109 2110 2111 2112 2113 2114 | void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ int (*tcl_UniCharAtIndex) (const char *src, size_t index); /* 320 */ int (*tcl_UniCharToLower) (int ch); /* 321 */ int (*tcl_UniCharToTitle) (int ch); /* 322 */ int (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 325 */ | | | | | 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 | void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ int (*tcl_UniCharAtIndex) (const char *src, size_t index); /* 320 */ int (*tcl_UniCharToLower) (int ch); /* 321 */ int (*tcl_UniCharToTitle) (int ch); /* 322 */ int (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 325 */ int (*tclUtfCharComplete) (const char *src, size_t length); /* 326 */ size_t (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ const char * (*tclUtfNext) (const char *src); /* 330 */ const char * (*tclUtfPrev) (const char *src, const char *start); /* 331 */ int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 333 */ int (*tcl_UtfToLower) (char *src); /* 334 */ int (*tcl_UtfToTitle) (char *src); /* 335 */ int (*tcl_UtfToChar16) (const char *src, unsigned short *chPtr); /* 336 */ int (*tcl_UtfToUpper) (char *src); /* 337 */ size_t (*tcl_WriteChars) (Tcl_Channel chan, const char *src, size_t srcLen); /* 338 */ |
︙ | ︙ | |||
2216 2217 2218 2219 2220 2221 2222 | void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ void * (*tcl_AttemptAlloc) (size_t size); /* 428 */ void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */ void * (*tcl_AttemptRealloc) (void *ptr, size_t size); /* 430 */ void * (*tcl_AttemptDbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 431 */ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, size_t length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ | | | | 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 | void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ void * (*tcl_AttemptAlloc) (size_t size); /* 428 */ void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */ void * (*tcl_AttemptRealloc) (void *ptr, size_t size); /* 430 */ void * (*tcl_AttemptDbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 431 */ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, size_t length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ void (*reserved435)(void); void (*reserved436)(void); 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 */ |
︙ | ︙ | |||
2273 2274 2275 2276 2277 2278 2279 | int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */ int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */ Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */ int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */ Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */ void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */ Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */ | | | | 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 | int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */ int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */ Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */ int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */ Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */ void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */ Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */ long long (*tcl_Seek) (Tcl_Channel chan, long long offset, int mode); /* 491 */ long long (*tcl_Tell) (Tcl_Channel chan); /* 492 */ Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 493 */ int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */ int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */ int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */ int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */ int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */ void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */ |
︙ | ︙ | |||
2342 2343 2344 2345 2346 2347 2348 | void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ Tcl_Obj * (*tcl_NewBignumObj) (void *value); /* 555 */ Tcl_Obj * (*tcl_DbNewBignumObj) (void *value, const char *file, int line); /* 556 */ void (*tcl_SetBignumObj) (Tcl_Obj *obj, void *value); /* 557 */ int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 558 */ int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */ | | | 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 | void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ Tcl_Obj * (*tcl_NewBignumObj) (void *value); /* 555 */ Tcl_Obj * (*tcl_DbNewBignumObj) (void *value, const char *file, int line); /* 556 */ void (*tcl_SetBignumObj) (Tcl_Obj *obj, void *value); /* 557 */ int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 558 */ int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */ int (*tcl_TruncateChannel) (Tcl_Channel chan, long long length); /* 560 */ Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */ void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */ void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */ void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */ void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */ int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, void *toInit); /* 566 */ Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */ |
︙ | ︙ | |||
2378 2379 2380 2381 2382 2383 2384 | unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */ unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */ unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */ int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */ int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */ int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */ int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */ | | | | | | | 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 | unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */ unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */ unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */ int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */ int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */ int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */ int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */ long long (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */ long long (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */ long long (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */ unsigned long long (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */ unsigned long long (*tcl_GetBlocksFromStat) (const Tcl_StatBuf *statPtr); /* 600 */ unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */ int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */ int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */ int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */ int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */ void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */ void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */ |
︙ | ︙ | |||
2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 | 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, size_t size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); /* 645 */ int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 648 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif | > > > > > > > > | 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 | 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, size_t size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); /* 645 */ int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 648 */ void (*reserved649)(void); void (*reserved650)(void); char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 653 */ int (*tcl_UtfCharComplete) (const char *src, size_t length); /* 654 */ const char * (*tcl_UtfNext) (const char *src); /* 655 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
2463 2464 2465 2466 2467 2468 2469 | (tclStubsPtr->tcl_Realloc) /* 5 */ #define Tcl_DbCkalloc \ (tclStubsPtr->tcl_DbCkalloc) /* 6 */ #define Tcl_DbCkfree \ (tclStubsPtr->tcl_DbCkfree) /* 7 */ #define Tcl_DbCkrealloc \ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */ | < < < < < < < < < < < < | 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 | (tclStubsPtr->tcl_Realloc) /* 5 */ #define Tcl_DbCkalloc \ (tclStubsPtr->tcl_DbCkalloc) /* 6 */ #define Tcl_DbCkfree \ (tclStubsPtr->tcl_DbCkfree) /* 7 */ #define Tcl_DbCkrealloc \ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */ #define Tcl_CreateFileHandler \ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ #define Tcl_DeleteFileHandler \ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */ #define Tcl_SetTimer \ (tclStubsPtr->tcl_SetTimer) /* 11 */ #define Tcl_Sleep \ (tclStubsPtr->tcl_Sleep) /* 12 */ #define Tcl_WaitForEvent \ (tclStubsPtr->tcl_WaitForEvent) /* 13 */ #define Tcl_AppendAllObjTypes \ |
︙ | ︙ | |||
2521 2522 2523 2524 2525 2526 2527 | (tclStubsPtr->tcl_DuplicateObj) /* 29 */ #define TclFreeObj \ (tclStubsPtr->tclFreeObj) /* 30 */ #define Tcl_GetBoolean \ (tclStubsPtr->tcl_GetBoolean) /* 31 */ #define Tcl_GetBooleanFromObj \ (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */ | | | | | | 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 | (tclStubsPtr->tcl_DuplicateObj) /* 29 */ #define TclFreeObj \ (tclStubsPtr->tclFreeObj) /* 30 */ #define Tcl_GetBoolean \ (tclStubsPtr->tcl_GetBoolean) /* 31 */ #define Tcl_GetBooleanFromObj \ (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */ #define TclGetByteArrayFromObj \ (tclStubsPtr->tclGetByteArrayFromObj) /* 33 */ #define Tcl_GetDouble \ (tclStubsPtr->tcl_GetDouble) /* 34 */ #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ /* Slot 36 is reserved */ #define Tcl_GetInt \ (tclStubsPtr->tcl_GetInt) /* 37 */ #define Tcl_GetIntFromObj \ (tclStubsPtr->tcl_GetIntFromObj) /* 38 */ #define Tcl_GetLongFromObj \ (tclStubsPtr->tcl_GetLongFromObj) /* 39 */ #define Tcl_GetObjType \ (tclStubsPtr->tcl_GetObjType) /* 40 */ #define TclGetStringFromObj \ (tclStubsPtr->tclGetStringFromObj) /* 41 */ #define Tcl_InvalidateStringRep \ (tclStubsPtr->tcl_InvalidateStringRep) /* 42 */ #define Tcl_ListObjAppendList \ (tclStubsPtr->tcl_ListObjAppendList) /* 43 */ #define Tcl_ListObjAppendElement \ (tclStubsPtr->tcl_ListObjAppendElement) /* 44 */ #define Tcl_ListObjGetElements \ |
︙ | ︙ | |||
2772 2773 2774 2775 2776 2777 2778 | (tclStubsPtr->tcl_GetInterpPath) /* 163 */ #define Tcl_GetParent \ (tclStubsPtr->tcl_GetParent) /* 164 */ #define Tcl_GetNameOfExecutable \ (tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */ #define Tcl_GetObjResult \ (tclStubsPtr->tcl_GetObjResult) /* 166 */ | < < < < < < | 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 | (tclStubsPtr->tcl_GetInterpPath) /* 163 */ #define Tcl_GetParent \ (tclStubsPtr->tcl_GetParent) /* 164 */ #define Tcl_GetNameOfExecutable \ (tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */ #define Tcl_GetObjResult \ (tclStubsPtr->tcl_GetObjResult) /* 166 */ #define Tcl_GetOpenFile \ (tclStubsPtr->tcl_GetOpenFile) /* 167 */ #define Tcl_GetPathType \ (tclStubsPtr->tcl_GetPathType) /* 168 */ #define Tcl_Gets \ (tclStubsPtr->tcl_Gets) /* 169 */ #define Tcl_GetsObj \ (tclStubsPtr->tcl_GetsObj) /* 170 */ #define Tcl_GetServiceMode \ |
︙ | ︙ | |||
3067 3068 3069 3070 3071 3072 3073 | (tclStubsPtr->tcl_UniCharToTitle) /* 322 */ #define Tcl_UniCharToUpper \ (tclStubsPtr->tcl_UniCharToUpper) /* 323 */ #define Tcl_UniCharToUtf \ (tclStubsPtr->tcl_UniCharToUtf) /* 324 */ #define Tcl_UtfAtIndex \ (tclStubsPtr->tcl_UtfAtIndex) /* 325 */ | | | | | | | | 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 | (tclStubsPtr->tcl_UniCharToTitle) /* 322 */ #define Tcl_UniCharToUpper \ (tclStubsPtr->tcl_UniCharToUpper) /* 323 */ #define Tcl_UniCharToUtf \ (tclStubsPtr->tcl_UniCharToUtf) /* 324 */ #define Tcl_UtfAtIndex \ (tclStubsPtr->tcl_UtfAtIndex) /* 325 */ #define TclUtfCharComplete \ (tclStubsPtr->tclUtfCharComplete) /* 326 */ #define Tcl_UtfBackslash \ (tclStubsPtr->tcl_UtfBackslash) /* 327 */ #define Tcl_UtfFindFirst \ (tclStubsPtr->tcl_UtfFindFirst) /* 328 */ #define Tcl_UtfFindLast \ (tclStubsPtr->tcl_UtfFindLast) /* 329 */ #define TclUtfNext \ (tclStubsPtr->tclUtfNext) /* 330 */ #define TclUtfPrev \ (tclStubsPtr->tclUtfPrev) /* 331 */ #define Tcl_UtfToExternal \ (tclStubsPtr->tcl_UtfToExternal) /* 332 */ #define Tcl_UtfToExternalDString \ (tclStubsPtr->tcl_UtfToExternalDString) /* 333 */ #define Tcl_UtfToLower \ (tclStubsPtr->tcl_UtfToLower) /* 334 */ #define Tcl_UtfToTitle \ |
︙ | ︙ | |||
3270 3271 3272 3273 3274 3275 3276 | (tclStubsPtr->tcl_AttemptRealloc) /* 430 */ #define Tcl_AttemptDbCkrealloc \ (tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */ #define Tcl_AttemptSetObjLength \ (tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */ #define Tcl_GetChannelThread \ (tclStubsPtr->tcl_GetChannelThread) /* 433 */ | | | | 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 | (tclStubsPtr->tcl_AttemptRealloc) /* 430 */ #define Tcl_AttemptDbCkrealloc \ (tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */ #define Tcl_AttemptSetObjLength \ (tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */ #define Tcl_GetChannelThread \ (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #define TclGetUnicodeFromObj \ (tclStubsPtr->tclGetUnicodeFromObj) /* 434 */ /* Slot 435 is reserved */ /* Slot 436 is reserved */ #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #define Tcl_DetachChannel \ (tclStubsPtr->tcl_DetachChannel) /* 438 */ #define Tcl_IsStandardChannel \ |
︙ | ︙ | |||
3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 | (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 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ | > > > > > > > > > > > > > > < < < < < < < < < < < < < < < < < | 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 | (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 */ /* Slot 649 is reserved */ /* Slot 650 is reserved */ #define Tcl_GetStringFromObj \ (tclStubsPtr->tcl_GetStringFromObj) /* 651 */ #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 652 */ #define Tcl_GetByteArrayFromObj \ (tclStubsPtr->tcl_GetByteArrayFromObj) /* 653 */ #define Tcl_UtfCharComplete \ (tclStubsPtr->tcl_UtfCharComplete) /* 654 */ #define Tcl_UtfNext \ (tclStubsPtr->tcl_UtfNext) /* 655 */ #define Tcl_UtfPrev \ (tclStubsPtr->tcl_UtfPrev) /* 656 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #define Tcl_PkgPresent(interp, name, version, exact) \ Tcl_PkgPresentEx(interp, name, version, exact, NULL) #define Tcl_PkgProvide(interp, name, version) \ Tcl_PkgProvideEx(interp, name, version, NULL) |
︙ | ︙ | |||
3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 | int intValue; int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue); if (result == TCL_OK) *ptr = (long)intValue; return result; } # endif #endif #ifdef TCL_MEM_DEBUG # undef Tcl_Alloc # define Tcl_Alloc(x) \ (Tcl_DbCkalloc((x), __FILE__, __LINE__)) # undef Tcl_Free # define Tcl_Free(x) \ | > > > > > > > > > > > > > > > > > > > > > > > > > | 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 | int intValue; int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue); if (result == TCL_OK) *ptr = (long)intValue; return result; } # endif #endif #undef Tcl_GetString #undef Tcl_GetUnicode #define Tcl_GetString(objPtr) \ Tcl_GetStringFromObj(objPtr, (size_t *)NULL) #define Tcl_GetUnicode(objPtr) \ Tcl_GetUnicodeFromObj(objPtr, (size_t *)NULL) #undef Tcl_GetStringFromObj #undef Tcl_GetUnicodeFromObj #undef Tcl_GetByteArrayFromObj #if defined(USE_TCL_STUBS) #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetStringFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (size_t *)sizePtr)) #else #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (TclGetStringFromObj)(objPtr, (int *)sizePtr) : (Tcl_GetStringFromObj)(objPtr, (size_t *)sizePtr)) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (TclGetByteArrayFromObj)(objPtr, (int *)sizePtr) : Tcl_GetByteArrayFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (TclGetUnicodeFromObj)(objPtr, (int *)sizePtr) : Tcl_GetUnicodeFromObj(objPtr, (size_t *)sizePtr)) #endif #ifdef TCL_MEM_DEBUG # undef Tcl_Alloc # define Tcl_Alloc(x) \ (Tcl_DbCkalloc((x), __FILE__, __LINE__)) # undef Tcl_Free # define Tcl_Free(x) \ |
︙ | ︙ | |||
3841 3842 3843 3844 3845 3846 3847 | #endif /* !TCL_MEM_DEBUG */ #define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value)) #define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value)) #define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) #define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value)) #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) | < | 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 | #endif /* !TCL_MEM_DEBUG */ #define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value)) #define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value)) #define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) #define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value)) #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_UTF_MAX <= 3 # undef Tcl_UniCharToUtfDString # define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString # undef Tcl_UtfToUniCharDString |
︙ | ︙ | |||
3922 3923 3924 3925 3926 3927 3928 | # define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((Tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) # define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteRaw()(chan, src, srcLen)+1))-1) # endif #endif #define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0) | | | | < | | 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 | # define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((Tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) # define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteRaw()(chan, src, srcLen)+1))-1) # endif #endif #define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0) #undef TclUnusedStubEntry #undef TclUtfCharComplete #undef TclUtfNext #undef TclUtfPrev #ifndef TCL_NO_DEPRECATED # define Tcl_CreateSlave Tcl_CreateChild # define Tcl_GetSlave Tcl_GetChild # define Tcl_GetMaster Tcl_GetParent #endif #endif /* _TCLDECLS */ |
Changes to generic/tclDictObj.c.
1 2 3 4 5 6 | /* * tclDictObj.c -- * * This file contains functions that implement the Tcl dict object type * and its accessor command. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclDictObj.c -- * * This file contains functions that implement the Tcl dict object type * and its accessor command. * * Copyright © 2002-2010 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" |
︙ | ︙ | |||
524 525 526 527 528 529 530 | /* * Assume that cPtr is never NULL since we know the number of array * elements already. */ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); | | | | | | 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 | /* * Assume that cPtr is never NULL since we know the number of array * elements already. */ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); elem = Tcl_GetStringFromObj(keyPtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); flagPtr[i+1] = TCL_DONT_QUOTE_HASH; valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); elem = Tcl_GetStringFromObj(valuePtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i+1); } bytesNeeded += numElems; /* * Pass 2: copy into string rep buffer. */ dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); TclOOM(dst, bytesNeeded); for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); elem = Tcl_GetStringFromObj(keyPtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; flagPtr[i+1] |= TCL_DONT_QUOTE_HASH; valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); elem = Tcl_GetStringFromObj(valuePtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i+1]); *dst++ = ' '; } (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); if (flagPtr != localFlags) { Tcl_Free(flagPtr); |
︙ | ︙ | |||
628 629 630 631 632 633 634 | TclDecrRefCount(discardedValue); } Tcl_SetHashValue(hPtr, objv[i+1]); Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ } } else { size_t length; | | | 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 | TclDecrRefCount(discardedValue); } Tcl_SetHashValue(hPtr, objv[i+1]); Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ } } else { size_t length; const char *nextElem = Tcl_GetStringFromObj(objPtr, &length); const char *limit = (nextElem + length); while (nextElem < limit) { Tcl_Obj *keyPtr, *valuePtr; const char *elemStart; size_t elemSize; int literal; |
︙ | ︙ |
Changes to generic/tclDisassemble.c.
1 2 3 4 5 6 | /* * tclDisassemble.c -- * * This file contains procedures that disassemble bytecode into either * human-readable or Tcl-processable forms. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclDisassemble.c -- * * This file contains procedures that disassemble bytecode into either * human-readable or Tcl-processable forms. * * Copyright © 1996-1998 Sun Microsystems, Inc. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * Copyright © 2013-2016 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
194 195 196 197 198 199 200 | Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ size_t maxChars) /* Maximum number of chars to print. */ { char *bytes; size_t length; | | | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 | Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ size_t maxChars) /* Maximum number of chars to print. */ { char *bytes; size_t length; bytes = Tcl_GetStringFromObj(objPtr, &length); TclPrintSource(outFile, bytes, TclMin(length, maxChars)); } /* *---------------------------------------------------------------------- * * TclPrintSource -- |
︙ | ︙ | |||
649 650 651 652 653 654 655 | } } if (suffixObj) { const char *bytes; size_t length; Tcl_AppendToObj(bufferObj, "\t# ", -1); | | | 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 | } } if (suffixObj) { const char *bytes; size_t length; Tcl_AppendToObj(bufferObj, "\t# ", -1); bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length); PrintSourceToObj(bufferObj, bytes, TclMin(length, 40)); } else if (suffixBuffer[0]) { Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer); if (suffixSrc) { PrintSourceToObj(bufferObj, suffixSrc, 40); } } |
︙ | ︙ |
Changes to generic/tclEncoding.c.
1 2 3 4 5 | /* * tclEncoding.c -- * * Contains the implementation of the encoding conversion package. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclEncoding.c -- * * Contains the implementation of the encoding conversion package. * * Copyright © 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
216 217 218 219 220 221 222 | static Tcl_EncodingFreeProc TableFreeProc; static Tcl_EncodingConvertProc TableFromUtfProc; static Tcl_EncodingConvertProc TableToUtfProc; static size_t unilen(const char *src); static Tcl_EncodingConvertProc Utf16ToUtfProc; static Tcl_EncodingConvertProc UtfToUtf16Proc; static Tcl_EncodingConvertProc UtfToUcs2Proc; | < < < < < < | < | 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 | static Tcl_EncodingFreeProc TableFreeProc; static Tcl_EncodingConvertProc TableFromUtfProc; static Tcl_EncodingConvertProc TableToUtfProc; static size_t unilen(const char *src); 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 intrep. This should help the lifetime of encodings be more useful. * See concerns raised in [Bug 1077262]. |
︙ | ︙ | |||
513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 | * * Side effects: * Depends on the memory, object, and IO subsystems. * *--------------------------------------------------------------------------- */ void TclInitEncodingSubsystem(void) { Tcl_EncodingType type; TableEncodingData *dataPtr; unsigned size; unsigned short i; union { char c; short s; } isLe; if (encodingsInitialized) { return; } | > > > > > > | | | | | | 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 | * * Side effects: * Depends on the memory, object, and IO subsystems. * *--------------------------------------------------------------------------- */ /* This flags must not conflict with other TCL_ENCODING_* flags in tcl.h */ #define TCL_ENCODING_MODIFIED 0x20 /* Converting NULL bytes to 0xC0 0x80 */ /* Since TCL_ENCODING_MODIFIED is only used for utf-8 and * TCL_ENCODING_LE is only used for utf-16/ucs-2, re-use the same value */ #define TCL_ENCODING_LE TCL_ENCODING_MODIFIED /* Little-endian encoding */ void TclInitEncodingSubsystem(void) { Tcl_EncodingType type; TableEncodingData *dataPtr; unsigned size; unsigned short i; union { char c; short s; } isLe; if (encodingsInitialized) { return; } isLe.s = TCL_ENCODING_LE; Tcl_MutexLock(&encodingMutex); Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&encodingMutex); /* * Create a few initial encodings. UTF-8 to UTF-8 translation is not a * no-op because it turns a stream of improperly formed UTF-8 into a * properly formed stream. */ type.encodingName = NULL; type.toUtfProc = BinaryProc; type.fromUtfProc = BinaryProc; type.freeProc = NULL; type.nullSize = 1; type.clientData = NULL; tclIdentityEncoding = Tcl_CreateEncoding(&type); type.encodingName = "utf-8"; type.toUtfProc = UtfToUtfProc; type.fromUtfProc = UtfToUtfProc; type.freeProc = NULL; type.nullSize = 1; type.clientData = NULL; 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 = Utf16ToUtfProc; type.fromUtfProc = UtfToUtf16Proc; type.freeProc = NULL; type.nullSize = 2; type.encodingName = "utf-16le"; type.clientData = INT2PTR(TCL_ENCODING_LE); Tcl_CreateEncoding(&type); type.encodingName = "utf-16be"; type.clientData = INT2PTR(0); Tcl_CreateEncoding(&type); type.encodingName = "utf-16"; type.clientData = INT2PTR(isLe.c); Tcl_CreateEncoding(&type); |
︙ | ︙ | |||
1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 | if (src == NULL) { srcLen = 0; } else if (srcLen == TCL_INDEX_NONE) { 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); } | > > > > < < | 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 | if (src == NULL) { srcLen = 0; } else if (srcLen == TCL_INDEX_NONE) { srcLen = encodingPtr->lengthProc(src); } flags = TCL_ENCODING_START | TCL_ENCODING_END; if (encodingPtr->toUtfProc == UtfToUtfProc) { flags |= TCL_ENCODING_MODIFIED; } 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; |
︙ | ︙ | |||
1182 1183 1184 1185 1186 1187 1188 | } else if (charLimited) { maxChars = *dstCharsPtr; } if (!noTerminate) { /* * If there are any null characters in the middle of the buffer, | | > > > < < | 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 | } 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; } 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'; } |
︙ | ︙ | |||
1265 1266 1267 1268 1269 1270 1271 | srcLen = 0; } else if (srcLen == TCL_INDEX_NONE) { srcLen = strlen(src); } flags = TCL_ENCODING_START | TCL_ENCODING_END; while (1) { result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, | | | | 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 | srcLen = 0; } else if (srcLen == TCL_INDEX_NONE) { 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); if (result != TCL_CONVERT_NOSPACE) { if (encodingPtr->nullSize == 2) { Tcl_DStringSetLength(dstPtr, soFar + 1); } Tcl_DStringSetLength(dstPtr, soFar); |
︙ | ︙ | |||
1367 1368 1369 1370 1371 1372 1373 | } if (dstCharsPtr == NULL) { dstCharsPtr = &dstChars; } dstLen -= encodingPtr->nullSize; result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen, | | | | 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 | } if (dstCharsPtr == NULL) { dstCharsPtr = &dstChars; } dstLen -= encodingPtr->nullSize; result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr); if (encodingPtr->nullSize == 2) { dst[*dstWrotePtr + 1] = '\0'; } dst[*dstWrotePtr] = '\0'; return result; } |
︙ | ︙ | |||
1395 1396 1397 1398 1399 1400 1401 | * Side effects: * The absolute pathname for the application is computed and stored to be * returned later by [info nameofexecutable]. * *--------------------------------------------------------------------------- */ #undef Tcl_FindExecutable | | | > | 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 | * 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 -- * |
︙ | ︙ | |||
2090 2091 2092 2093 2094 2095 2096 | memcpy(dst, src, srcLen); return result; } /* *------------------------------------------------------------------------- * | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < | < < < < | < < | > | | | | | | > > > > > > | | > > > > | > | > > > > > > | > | > > | | > | | | | | | | | | 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 | memcpy(dst, src, srcLen); return result; } /* *------------------------------------------------------------------------- * * UtfToUtfProc -- * * Convert from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8 translation * is not a no-op, because it will turn a stream of improperly formed * UTF-8 into a properly formed stream. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * 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 * 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; const char *dstStart, *dstEnd; int result, numChars, charLimit = INT_MAX; int ch; result = TCL_OK; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= 6; } if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } dstStart = dst; flags |= PTR2INT(clientData); dstEnd = dst + dstLen - TCL_UTF_MAX; 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; 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 ((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)) { *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; } dst += Tcl_UniCharToUtf(ch, dst); } } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; |
︙ | ︙ | |||
2339 2340 2341 2342 2343 2344 2345 | * None. * *------------------------------------------------------------------------- */ static int Utf16ToUtfProc( | | | 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 | * None. * *------------------------------------------------------------------------- */ static int Utf16ToUtfProc( 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 |
︙ | ︙ | |||
2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 | * output buffer. */ { const char *srcStart, *srcEnd; const char *dstEnd, *dstStart; int result, numChars, charLimit = INT_MAX; unsigned short ch; if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } result = TCL_OK; | > > | > > > > | > > | > | > > | 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 | * output buffer. */ { const char *srcStart, *srcEnd; const char *dstEnd, *dstStart; int result, numChars, charLimit = INT_MAX; unsigned short ch; flags |= PTR2INT(clientData); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } result = TCL_OK; /* * Check alignment with utf-16 (2 == sizeof(UTF-16)) */ if ((srcLen % 2) != 0) { result = TCL_CONVERT_MULTIBYTE; srcLen--; } /* * If last code point is a high surrogate, we cannot handle that yet. */ if ((srcLen >= 2) && ((src[srcLen - ((flags & TCL_ENCODING_LE)?1:2)] & 0xFC) == 0xD8)) { result = TCL_CONVERT_MULTIBYTE; srcLen-= 2; } 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[1] & 0xFF) << 8 | (src[0] & 0xFF); } else { ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF); } /* * Special case for 1-byte utf chars for speed. Make sure we work with * unsigned short-size data. */ if (ch && ch < 0x80) { *dst++ = (ch & 0xFF); } else { dst += Tcl_UniCharToUtf(ch, dst); } src += sizeof(unsigned short); } |
︙ | ︙ | |||
2434 2435 2436 2437 2438 2439 2440 | * None. * *------------------------------------------------------------------------- */ static int UtfToUtf16Proc( | | | < < < < < | < < | > | | < < | | | | | | | < < < < < | | | < < | | > > < < < < | 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 | * 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 * 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; 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; } src += TclUtfToUCS4(src, &ch); 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); *dst++ = ((ch >> 8) & 0x3) | 0xDC; } } else { if (ch <= 0xFFFF) { *dst++ = (ch >> 8); *dst++ = (ch & 0xFF); } else { *dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8; *dst++ = (((ch - 0x10000) >> 10) & 0xFF); *dst++ = ((ch >> 8) & 0x3) | 0xDC; *dst++ = (ch & 0xFF); } } } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } |
︙ | ︙ | |||
2549 2550 2551 2552 2553 2554 2555 | * None. * *------------------------------------------------------------------------- */ static int UtfToUcs2Proc( | | | 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 | * None. * *------------------------------------------------------------------------- */ static int UtfToUcs2Proc( 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 |
︙ | ︙ | |||
2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 | const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; #if TCL_UTF_MAX <= 3 int len; #endif Tcl_UniChar ch = 0; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } | > | 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 | const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; #if TCL_UTF_MAX <= 3 int len; #endif Tcl_UniChar ch = 0; flags |= PTR2INT(clientData); srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } |
︙ | ︙ | |||
2620 2621 2622 2623 2624 2625 2626 | #endif /* * Need to handle this in a way that won't cause misalignment by * casting dst to a Tcl_UniChar. [Bug 1122671] */ | | | 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 | #endif /* * Need to handle this in a way that won't cause misalignment by * casting dst to a Tcl_UniChar. [Bug 1122671] */ if (flags & TCL_ENCODING_LE) { *dst++ = (ch & 0xFF); *dst++ = (ch >> 8); } else { *dst++ = (ch >> 8); *dst++ = (ch & 0xFF); } } |
︙ | ︙ | |||
3028 3029 3030 3031 3032 3033 3034 | #endif ) { if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } #if TCL_UTF_MAX <= 3 | | > > | 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 | #endif ) { if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len = 4; } #endif /* * Plunge on, using '?' as a fallback character. */ ch = (Tcl_UniChar) '?'; } |
︙ | ︙ | |||
3073 3074 3075 3076 3077 3078 3079 | */ static void TableFreeProc( ClientData clientData) /* TableEncodingData that specifies * encoding. */ { | | | 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 | */ static void TableFreeProc( ClientData clientData) /* TableEncodingData that specifies * encoding. */ { TableEncodingData *dataPtr = (TableEncodingData *) clientData; /* * Make sure we aren't freeing twice on shutdown. [Bug 219314] */ Tcl_Free(dataPtr->toUnicode); dataPtr->toUnicode = NULL; |
︙ | ︙ | |||
3131 3132 3133 3134 3135 3136 3137 | 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. */ { | | | 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 | 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) { |
︙ | ︙ | |||
3695 3696 3697 3698 3699 3700 3701 | Tcl_DecrRefCount(libPathObj); Tcl_DecrRefCount(encodingObj); *encodingPtr = libraryPath.encoding; if (*encodingPtr) { ((Encoding *)(*encodingPtr))->refCount++; } | | | 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 | Tcl_DecrRefCount(libPathObj); Tcl_DecrRefCount(encodingObj); *encodingPtr = libraryPath.encoding; if (*encodingPtr) { ((Encoding *)(*encodingPtr))->refCount++; } bytes = Tcl_GetStringFromObj(searchPathObj, lengthPtr); *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, bytes, *lengthPtr + 1); Tcl_DecrRefCount(searchPathObj); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclEnsemble.c.
1 2 3 4 5 6 | /* * tclEnsemble.c -- * * Contains support for ensembles (see TIP#112), which provide simple * mechanism for creating composite commands on top of namespaces. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclEnsemble.c -- * * Contains support for ensembles (see TIP#112), which provide simple * mechanism for creating composite commands on top of namespaces. * * Copyright © 2005-2013 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
1807 1808 1809 1810 1811 1812 1813 | * it (will be an error for a non-unique * prefix). */ char *fullName = NULL; /* Full name of the subcommand. */ size_t stringLength, i; size_t tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; | | | 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 | * it (will be an error for a non-unique * prefix). */ char *fullName = NULL; /* Full name of the subcommand. */ size_t stringLength, i; size_t tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; subcmdName = Tcl_GetStringFromObj(subObj, &stringLength); for (i=0 ; i<tableLength ; i++) { int cmp = strncmp(subcmdName, ensemblePtr->subcommandArrayPtr[i], stringLength); if (cmp == 0) { if (fullName != NULL) { |
︙ | ︙ | |||
2989 2990 2991 2992 2993 2994 2995 | const char *str; Tcl_Obj *matchObj = NULL; if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { goto failed; } for (i=0 ; i<len ; i++) { | | | 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 | const char *str; Tcl_Obj *matchObj = NULL; if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { goto failed; } for (i=0 ; i<len ; i++) { str = Tcl_GetStringFromObj(elems[i], &sclen); if ((sclen == numBytes) && !memcmp(word, str, numBytes)) { /* * Exact match! Excellent! */ result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj); if (result != TCL_OK || targetCmdObj == NULL) { |
︙ | ︙ | |||
3392 3393 3394 3395 3396 3397 3398 | * difference. Hence the call to TclContinuationsEnterDerived... */ Tcl_ListObjGetElements(NULL, replacements, &numWords, &words); for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i < numWords+1) { | | | 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 | * difference. Hence the call to TclContinuationsEnterDerived... */ Tcl_ListObjGetElements(NULL, replacements, &numWords, &words); for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i < numWords+1) { bytes = Tcl_GetStringFromObj(words[i-1], &length); PushLiteral(envPtr, bytes, length); continue; } SetLineInformation(i); if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) { int literal = TclRegisterLiteral(envPtr, |
︙ | ︙ | |||
3421 3422 3423 3424 3425 3426 3427 | /* * Push the name of the command we're actually dispatching to as part of * the implementation. */ TclNewObj(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); | | | 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 | /* * Push the name of the command we're actually dispatching to as part of * the implementation. */ TclNewObj(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); bytes = Tcl_GetStringFromObj(objPtr, &length); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } cmdLit = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags); TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr); TclEmitPush(cmdLit, envPtr); TclDecrRefCount(objPtr); |
︙ | ︙ |
Changes to generic/tclEnv.c.
1 2 3 4 5 6 7 8 | /* * tclEnv.c -- * * Tcl support for environment variables, including a setenv function. * This file contains the generic portion of the environment module. It * is primarily responsible for keeping the "env" arrays in sync with the * system environment variables. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclEnv.c -- * * Tcl support for environment variables, including a setenv function. * This file contains the generic portion of the environment module. It * is primarily responsible for keeping the "env" arrays in sync with the * system environment variables. * * Copyright © 1991-1994 The Regents of the University of California. * Copyright © 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
32 33 34 35 36 37 38 39 40 41 42 43 44 45 | # define tenviron2utfdstr(tenvstr, len, dstr) \ Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr) # define utf2tenvirondstr(str, len, dstr) \ Tcl_UtfToExternalDString(NULL, str, len, dstr) # define techar char #endif static struct { size_t cacheSize; /* Number of env strings in cache. */ char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV techar **ourEnviron; /* Cache of the array that we allocate. We * need to track this in case another | > > > > > | 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | # define tenviron2utfdstr(tenvstr, len, dstr) \ Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr) # define utf2tenvirondstr(str, len, dstr) \ Tcl_UtfToExternalDString(NULL, str, len, dstr) # define techar char #endif /* MODULE_SCOPE */ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ static struct { size_t cacheSize; /* Number of env strings in cache. */ char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV techar **ourEnviron; /* Cache of the array that we allocate. We * need to track this in case another |
︙ | ︙ | |||
413 414 415 416 417 418 419 420 421 422 423 424 425 426 | name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString); value = (char *)strchr(name, '='); if ((value != NULL) && (value != name)) { value[0] = '\0'; TclSetEnv(name, value+1); } Tcl_DStringFree(&nameString); return 0; } /* *---------------------------------------------------------------------- | > | 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 | 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; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
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 | { /* * For array traces, let TclSetupEnv do all the work. */ if (flags & TCL_TRACE_ARRAY) { TclSetupEnv(interp); return NULL; } /* * If name2 is NULL, then return and do nothing. */ if (name2 == NULL) { return NULL; } /* * If a value is being set, call TclSetEnv to do all of the work. */ if (flags & TCL_TRACE_WRITES) { const char *value; value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); } /* * If a value is being read, call TclGetEnv to do all of the work. */ if (flags & TCL_TRACE_READS) { | > > | 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 | { /* * For array traces, let TclSetupEnv do all the work. */ if (flags & TCL_TRACE_ARRAY) { TclSetupEnv(interp); TclEnvEpoch++; return NULL; } /* * If name2 is NULL, then return and do nothing. */ if (name2 == NULL) { return NULL; } /* * If a value is being set, call TclSetEnv to do all of the work. */ if (flags & TCL_TRACE_WRITES) { const char *value; value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); TclEnvEpoch++; } /* * If a value is being read, call TclGetEnv to do all of the work. */ if (flags & TCL_TRACE_READS) { |
︙ | ︙ | |||
662 663 664 665 666 667 668 669 670 671 672 673 674 675 | /* * For unset traces, let TclUnsetEnv do all the work. */ if (flags & TCL_TRACE_UNSETS) { TclUnsetEnv(name2); } return NULL; } /* *---------------------------------------------------------------------- * | > | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 | /* * For unset traces, let TclUnsetEnv do all the work. */ if (flags & TCL_TRACE_UNSETS) { TclUnsetEnv(name2); TclEnvEpoch++; } return NULL; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclEvent.c.
1 2 3 4 5 6 7 | /* * tclEvent.c -- * * This file implements some general event related interfaces including * background errors, exit handlers, and the "vwait" and "update" command * functions. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclEvent.c -- * * This file implements some general event related interfaces including * background errors, exit handlers, and the "vwait" and "update" command * functions. * * Copyright © 1990-1994 The Regents of the University of California. * Copyright © 1994-1998 Sun Microsystems, Inc. * Copyright © 2004 Zoran Vasiljevic. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
1009 1010 1011 1012 1013 1014 1015 | * * Side effects: * Varied, see the respective initialization routines. * *------------------------------------------------------------------------- */ | > | > > > > > > > > | 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 | * * Side effects: * Varied, see the respective initialization routines. * *------------------------------------------------------------------------- */ MODULE_SCOPE const TclStubs tclStubs; static const struct { const TclStubs *stubs; const char version[12]; } stubInfo = { &tclStubs, TCL_PATCH_LEVEL }; const char * Tcl_InitSubsystems(void) { if (inExit != 0) { Tcl_Panic("Tcl_InitSubsystems called while exiting"); } if (subsystemsInitialized == 0) { |
︙ | ︙ | |||
1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 | TclInitEncodingSubsystem(); /* Process wide encoding init. */ TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ subsystemsInitialized = 1; } TclpInitUnlock(); } TclInitNotifier(); } /* *---------------------------------------------------------------------- * * Tcl_Finalize -- * | > | 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 | TclInitEncodingSubsystem(); /* Process wide encoding init. */ TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ subsystemsInitialized = 1; } TclpInitUnlock(); } TclInitNotifier(); return stubInfo.version; } /* *---------------------------------------------------------------------- * * Tcl_Finalize -- * |
︙ | ︙ | |||
1498 1499 1500 1501 1502 1503 1504 | } else if (objc == 2) { if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum updateOptionsEnum) optionIndex) { case OPT_IDLETASKS: | | | 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 | } else if (objc == 2) { if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum updateOptionsEnum) optionIndex) { case OPT_IDLETASKS: flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT; break; default: Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions"); } } else { Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?"); return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclExecute.c.
1 2 3 4 5 | /* * tclExecute.c -- * * This file contains procedures that execute byte-compiled Tcl commands. * | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclExecute.c -- * * This file contains procedures that execute byte-compiled Tcl commands. * * Copyright © 1996-1997 Sun Microsystems, Inc. * Copyright © 1998-2000 Scriptics Corporation. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * Copyright © 2002-2010 Miguel Sofer. * Copyright © 2005-2007 Donal K. Fellows. * Copyright © 2007 Daniel A. Steffen <[email protected]> * Copyright © 2006-2008 Joe Mistachkin. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
1433 1434 1435 1436 1437 1438 1439 | if (codePtr == NULL) { /* * TIP #280: No invoker (yet) - Expression compilation. */ size_t length; | | | 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 | if (codePtr == NULL) { /* * TIP #280: No invoker (yet) - Expression compilation. */ size_t length; const char *string = Tcl_GetStringFromObj(objPtr, &length); TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); TclCompileExpr(interp, string, length, &compEnv, 0); /* * Successful compilation. If the expression yielded no instructions, * push an zero object as the expression's result. |
︙ | ︙ | |||
4895 4896 4897 4898 4899 4900 4901 | NEXT_INST_F(9, 1, 1); case INST_LIST_IN: case INST_LIST_NOT_IN: /* Basic list containment operators. */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; | | | | 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 | NEXT_INST_F(9, 1, 1); case INST_LIST_IN: case INST_LIST_NOT_IN: /* Basic list containment operators. */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; s1 = Tcl_GetStringFromObj(valuePtr, &s1len); TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } match = 0; if (length > 0) { int i = 0; Tcl_Obj *o; /* * An empty list doesn't match anything. */ do { Tcl_ListObjIndex(NULL, value2Ptr, i, &o); if (o != NULL) { s2 = Tcl_GetStringFromObj(o, &s2len); } else { s2 = ""; s2len = 0; } if (s1len == s2len) { match = (memcmp(s1, s2, s1len) == 0); } |
︙ | ︙ | |||
5038 5039 5040 5041 5042 5043 5044 | TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "u\n", O2S(valuePtr), slength)); NEXT_INST_F(1, 1, 1); case INST_STR_UPPER: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { | | | | | 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 | TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "u\n", O2S(valuePtr), slength)); NEXT_INST_F(1, 1, 1); case INST_STR_UPPER: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { s1 = Tcl_GetStringFromObj(valuePtr, &slength); TclNewStringObj(objResultPtr, s1, slength); slength = Tcl_UtfToUpper(TclGetString(objResultPtr)); Tcl_SetObjLength(objResultPtr, slength); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { slength = Tcl_UtfToUpper(TclGetString(valuePtr)); Tcl_SetObjLength(valuePtr, slength); TclFreeIntRep(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 = Tcl_GetStringFromObj(valuePtr, &slength); TclNewStringObj(objResultPtr, s1, slength); slength = Tcl_UtfToLower(TclGetString(objResultPtr)); Tcl_SetObjLength(objResultPtr, slength); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { slength = Tcl_UtfToLower(TclGetString(valuePtr)); Tcl_SetObjLength(valuePtr, slength); TclFreeIntRep(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 = Tcl_GetStringFromObj(valuePtr, &slength); TclNewStringObj(objResultPtr, s1, slength); slength = Tcl_UtfToTitle(TclGetString(objResultPtr)); Tcl_SetObjLength(objResultPtr, slength); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { slength = Tcl_UtfToTitle(TclGetString(valuePtr)); |
︙ | ︙ | |||
5108 5109 5110 5111 5112 5113 5114 | } CACHE_STACK_INFO(); if (index >= slength) { TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( | | | 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 | } CACHE_STACK_INFO(); if (index >= slength) { TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( TclGetByteArrayFromObj(valuePtr, NULL)+index, 1); } else if (valuePtr->bytes && slength == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); } else { char buf[4] = ""; int ch = Tcl_GetUniChar(valuePtr, index); |
︙ | ︙ | |||
5300 5301 5302 5303 5304 5305 5306 | if (value3Ptr == value2Ptr) { objResultPtr = valuePtr; goto doneStringMap; } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; goto doneStringMap; } | | | | | 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 | if (value3Ptr == value2Ptr) { objResultPtr = valuePtr; goto doneStringMap; } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; goto doneStringMap; } ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength); if (slength == 0) { objResultPtr = valuePtr; goto doneStringMap; } ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); if (length2 > slength || length2 == 0) { objResultPtr = valuePtr; goto doneStringMap; } else if (length2 == slength) { if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * slength)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } goto doneStringMap; } ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; end = ustring1 + slength; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) |
︙ | ︙ | |||
5352 5353 5354 5355 5356 5357 5358 | TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); NEXT_INST_V(1, 3, 1); case INST_STR_FIND: objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0); | | | | | 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 | TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); NEXT_INST_V(1, 3, 1); case INST_STR_FIND: objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0); TRACE(("%.20s %.20s => %s\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1); TRACE(("%.20s %.20s => %s\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_STR_CLASS: opnd = TclGetInt1AtPtr(pc+1); valuePtr = OBJ_AT_TOS; TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name, O2S(valuePtr))); ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength); match = 1; if (slength > 0) { int ch; end = ustring1 + slength; for (p=ustring1 ; p<end ; ) { p += TclUniCharToUCS4(p, &ch); if (!tclStringClassTable[opnd].comparator(ch)) { |
︙ | ︙ | |||
5399 5400 5401 5402 5403 5404 5405 | * both. */ if (TclHasIntRep(valuePtr, &tclStringType) || TclHasIntRep(value2Ptr, &tclStringType)) { Tcl_UniChar *ustring1, *ustring2; | | | | | | 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 | * both. */ if (TclHasIntRep(valuePtr, &tclStringType) || TclHasIntRep(value2Ptr, &tclStringType)) { Tcl_UniChar *ustring1, *ustring2; ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength); ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); match = TclUniCharMatch(ustring1, slength, ustring2, length2, nocase); } else if (TclIsPureByteArray(valuePtr) && !nocase) { unsigned char *bytes1, *bytes2; size_t wlen1 = 0, wlen2 = 0; bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &wlen1); bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &wlen2); match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0); } else { match = Tcl_StringCaseMatch(TclGetString(valuePtr), TclGetString(value2Ptr), nocase); } /* |
︙ | ︙ | |||
5435 5436 5437 5438 5439 5440 5441 | { const char *string1, *string2; size_t trim1, trim2; case INST_STR_TRIM_LEFT: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ | | | | | | | | 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 | { const char *string1, *string2; size_t trim1, trim2; case INST_STR_TRIM_LEFT: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ string2 = Tcl_GetStringFromObj(value2Ptr, &length2); string1 = Tcl_GetStringFromObj(valuePtr, &slength); trim1 = TclTrimLeft(string1, slength, string2, length2); trim2 = 0; goto createTrimmedString; case INST_STR_TRIM_RIGHT: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ string2 = Tcl_GetStringFromObj(value2Ptr, &length2); string1 = Tcl_GetStringFromObj(valuePtr, &slength); trim2 = TclTrimRight(string1, slength, string2, length2); trim1 = 0; goto createTrimmedString; case INST_STR_TRIM: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ string2 = Tcl_GetStringFromObj(value2Ptr, &length2); string1 = Tcl_GetStringFromObj(valuePtr, &slength); trim1 = TclTrim(string1, slength, string2, length2, &trim2); createTrimmedString: /* * Careful here; trim set often contains non-ASCII characters so we * take care when printing. [Bug 971cb4f1db] */ |
︙ | ︙ | |||
9313 9314 9315 9316 9317 9318 9319 | * None. * *---------------------------------------------------------------------- */ static int EvalStatsCmd( | | | 9313 9314 9315 9316 9317 9318 9319 9320 9321 9322 9323 9324 9325 9326 9327 | * None. * *---------------------------------------------------------------------- */ static int EvalStatsCmd( TCL_UNUSED(void *), /* Unused. */ Tcl_Interp *interp, /* The current interpreter. */ int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The argument strings. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; ByteCodeStats *statsPtr = &iPtr->stats; |
︙ | ︙ | |||
9470 9471 9472 9473 9474 9475 9476 | strBytesSharedOnce = 0.0; for (i = 0; i < globalTablePtr->numBuckets; i++) { for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL; entryPtr = entryPtr->nextPtr) { if (TclHasIntRep(entryPtr->objPtr, &tclByteCodeType)) { numByteCodeLits++; } | | | 9470 9471 9472 9473 9474 9475 9476 9477 9478 9479 9480 9481 9482 9483 9484 | strBytesSharedOnce = 0.0; for (i = 0; i < globalTablePtr->numBuckets; i++) { for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL; entryPtr = entryPtr->nextPtr) { if (TclHasIntRep(entryPtr->objPtr, &tclByteCodeType)) { numByteCodeLits++; } (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length); refCountSum += entryPtr->refCount; objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj)); strBytesIfUnshared += (entryPtr->refCount * (length+1)); if (entryPtr->refCount > 1) { numSharedMultX++; strBytesSharedMultX += (length+1); } else { |
︙ | ︙ | |||
9607 9608 9609 9610 9611 9612 9613 | minSizeDecade = maxSizeDecade = 0; for (i = 0; i < 31; i++) { if (statsPtr->srcCount[i] > 0) { minSizeDecade = i; break; } } | | | | > | | | > | | | > | 9607 9608 9609 9610 9611 9612 9613 9614 9615 9616 9617 9618 9619 9620 9621 9622 9623 9624 9625 9626 9627 9628 9629 9630 9631 9632 9633 9634 9635 9636 9637 9638 9639 9640 9641 9642 9643 9644 9645 9646 9647 9648 9649 9650 9651 9652 9653 9654 9655 9656 9657 9658 9659 9660 9661 9662 9663 9664 9665 9666 9667 9668 9669 9670 9671 9672 9673 9674 9675 | minSizeDecade = maxSizeDecade = 0; for (i = 0; i < 31; i++) { if (statsPtr->srcCount[i] > 0) { minSizeDecade = i; break; } } for (i = 31; i != (size_t)-1; i--) { if (statsPtr->srcCount[i] > 0) { break; /* maxSizeDecade to consume 'i' value * below... */ } } maxSizeDecade = i; sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->srcCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n"); minSizeDecade = maxSizeDecade = 0; for (i = 0; i < 31; i++) { if (statsPtr->byteCodeCount[i] > 0) { minSizeDecade = i; break; } } for (i = 31; i != (size_t)-1; i--) { if (statsPtr->byteCodeCount[i] > 0) { break; /* maxSizeDecade to consume 'i' value * below... */ } } maxSizeDecade = i; sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->byteCodeCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to ms\t\tPercentage\n"); minSizeDecade = maxSizeDecade = 0; for (i = 0; i < 31; i++) { if (statsPtr->lifetimeCount[i] > 0) { minSizeDecade = i; break; } } for (i = 31; i != (size_t)-1; i--) { if (statsPtr->lifetimeCount[i] > 0) { break; /* maxSizeDecade to consume 'i' value * below... */ } } maxSizeDecade = i; sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->lifetimeCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n", decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed)); } |
︙ | ︙ | |||
9693 9694 9695 9696 9697 9698 9699 | #endif Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); if (objc == 1) { Tcl_SetObjResult(interp, objPtr); } else { Tcl_Channel outChan; | | | 9696 9697 9698 9699 9700 9701 9702 9703 9704 9705 9706 9707 9708 9709 9710 | #endif Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); if (objc == 1) { Tcl_SetObjResult(interp, objPtr); } else { Tcl_Channel outChan; char *str = Tcl_GetStringFromObj(objv[1], &length); if (length) { if (strcmp(str, "stdout") == 0) { outChan = Tcl_GetStdChannel(TCL_STDOUT); } else if (strcmp(str, "stderr") == 0) { outChan = Tcl_GetStdChannel(TCL_STDERR); } else { |
︙ | ︙ |
Changes to generic/tclFCmd.c.
1 2 3 4 5 6 | /* * tclFCmd.c * * This file implements the generic portion of file manipulation * subcommands of the "file" command. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclFCmd.c * * This file implements the generic portion of file manipulation * subcommands of the "file" command. * * Copyright © 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclFileSystem.h" |
︙ | ︙ | |||
1387 1388 1389 1390 1391 1392 1393 | if (objc > 1) { nameVarObj = objv[1]; TclNewObj(nameObj); } if (objc > 2) { size_t length; Tcl_Obj *templateObj = objv[2]; | | | 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 | if (objc > 1) { nameVarObj = objv[1]; TclNewObj(nameObj); } if (objc > 2) { size_t length; Tcl_Obj *templateObj = objv[2]; const char *string = Tcl_GetStringFromObj(templateObj, &length); /* * Treat an empty string as if it wasn't there. */ if (length == 0) { goto makeTemporary; |
︙ | ︙ | |||
1539 1540 1541 1542 1543 1544 1545 | Tcl_WrongNumArgs(interp, 1, objv, "?template?"); return TCL_ERROR; } if (objc > 1) { int length; Tcl_Obj *templateObj = objv[1]; | | | 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 | Tcl_WrongNumArgs(interp, 1, objv, "?template?"); return TCL_ERROR; } if (objc > 1) { int length; Tcl_Obj *templateObj = objv[1]; const char *string = Tcl_GetStringFromObj(templateObj, &length); const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS); /* * Treat an empty string as if it wasn't there. */ if (length == 0) { |
︙ | ︙ |
Changes to generic/tclFileName.c.
1 2 3 4 5 6 | /* * tclFileName.c -- * * This file contains routines for converting file names betwen native * and network form. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclFileName.c -- * * This file contains routines for converting file names betwen native * and network form. * * Copyright © 1995-1998 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclRegexp.h" |
︙ | ︙ | |||
238 239 240 241 242 243 244 | && path[3] >= '1' && path[3] <= '9') { /* * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { abs = 4; | | | 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 | && path[3] >= '1' && path[3] <= '9') { /* * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { abs = 4; } else if (path[4] == ':' && path[5] == '\0') { abs = 5; } } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* * Have match for 'con'. */ |
︙ | ︙ | |||
260 261 262 263 264 265 266 | if (path[3] >= '1' && path[3] <= '9') { /* * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { abs = 4; | | | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | if (path[3] >= '1' && path[3] <= '9') { /* * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { abs = 4; } else if (path[4] == ':' && path[5] == '\0') { abs = 5; } } } else if ((path[0] == 'p' || path[0] == 'P') && (path[1] == 'r' || path[1] == 'R') && (path[2] == 'n' || path[2] == 'N') |
︙ | ︙ | |||
574 575 576 577 578 579 580 | /* * Calculate space required for the result. */ size = 1; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); | | | | 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 | /* * Calculate space required for the result. */ size = 1; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); (void)Tcl_GetStringFromObj(eltPtr, &len); size += len + 1; } /* * Allocate a buffer large enough to hold the contents of all of the list * plus the argv pointers and the terminating NULL pointer. */ *argvPtr = (const char **)Tcl_Alloc( ((((*argcPtr) + 1) * sizeof(char *)) + size)); /* * Position p after the last argv pointer and copy the contents of the * list in, piece by piece. */ p = (char *) &(*argvPtr)[(*argcPtr) + 1]; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); str = Tcl_GetStringFromObj(eltPtr, &len); memcpy(p, str, len + 1); p += len+1; } /* * Now set up the argv pointers. */ |
︙ | ︙ | |||
857 858 859 860 861 862 863 | { int needsSep; size_t length; char *dest; const char *p; const char *start; | | | 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 | { int needsSep; size_t length; char *dest; const char *p; const char *start; start = Tcl_GetStringFromObj(prefix, &length); /* * Remove the ./ from tilde prefixed elements, and drive-letter prefixed * elements on Windows, unless it is the first component. */ p = joining; |
︙ | ︙ | |||
885 886 887 888 889 890 891 | case TCL_PLATFORM_UNIX: /* * Append a separator if needed. */ if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); | | | 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 | case TCL_PLATFORM_UNIX: /* * Append a separator if needed. */ if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); (void)Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; /* * Append the element, eliminating duplicate and trailing slashes. */ |
︙ | ︙ | |||
921 922 923 924 925 926 927 | /* * Check to see if we need to append a separator. */ if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); | | | 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 | /* * Check to see if we need to append a separator. */ if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); (void)Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; /* * Append the element, eliminating duplicate and trailing slashes. */ |
︙ | ︙ | |||
1005 1006 1007 1008 1009 1010 1011 | Tcl_IncrRefCount(resultObj); Tcl_DecrRefCount(listObj); /* * Store the result. */ | | | 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 | Tcl_IncrRefCount(resultObj); Tcl_DecrRefCount(listObj); /* * Store the result. */ resultStr = Tcl_GetStringFromObj(resultObj, &len); Tcl_DStringAppend(resultPtr, resultStr, len); Tcl_DecrRefCount(resultObj); /* * Return a pointer to the result. */ |
︙ | ︙ | |||
1364 1365 1366 1367 1368 1369 1370 | separators = "/\\:"; break; } if (dir == PATH_GENERAL) { size_t pathlength; const char *last; | | | 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 | separators = "/\\:"; break; } if (dir == PATH_GENERAL) { size_t pathlength; const char *last; const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength); /* * Find the last path separator in the path */ last = first + pathlength; for (; last != first; last--) { |
︙ | ︙ | |||
1467 1468 1469 1470 1471 1472 1473 | globTypes->macCreator = NULL; while (--length >= 0) { size_t len; const char *str; Tcl_ListObjIndex(interp, typePtr, length, &look); | | | 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 | globTypes->macCreator = NULL; while (--length >= 0) { size_t len; const char *str; Tcl_ListObjIndex(interp, typePtr, length, &look); str = Tcl_GetStringFromObj(look, &len); if (strcmp("readonly", str) == 0) { globTypes->perm |= TCL_GLOB_PERM_RONLY; } else if (strcmp("hidden", str) == 0) { globTypes->perm |= TCL_GLOB_PERM_HIDDEN; } else if (len == 1) { switch (str[0]) { case 'r': |
︙ | ︙ | |||
1998 1999 2000 2001 2002 2003 2004 | * If this length has never been set, set it here. */ if (pathPrefix == NULL) { Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL"); } | | | | 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 | * If this length has never been set, set it here. */ if (pathPrefix == NULL) { Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL"); } pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen); if (prefixLen > 0 && (strchr(separators, pre[prefixLen-1]) == NULL)) { /* * If we're on Windows and the prefix is a volume relative one * like 'C:', then there won't be a path separator in between, so * no need to skip it here. */ if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (prefixLen != 2) || (pre[1] != ':')) { prefixLen++; } } Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv); for (i = 0; i< objc; i++) { size_t len; const char *oldStr = Tcl_GetStringFromObj(objv[i], &len); Tcl_Obj *elem; if (len == prefixLen) { if ((pattern[0] == '\0') || (strchr(separators, pattern[0]) == NULL)) { TclNewLiteralStringObj(elem, "."); } else { |
︙ | ︙ | |||
2368 2369 2370 2371 2372 2373 2374 | Tcl_ListObjLength(NULL, matchesObj, &end); while (repair < end) { const char *bytes; size_t numBytes; Tcl_Obj *fixme, *newObj; Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme); | | | 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 | Tcl_ListObjLength(NULL, matchesObj, &end); while (repair < end) { const char *bytes; size_t numBytes; Tcl_Obj *fixme, *newObj; Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme); bytes = Tcl_GetStringFromObj(fixme, &numBytes); newObj = Tcl_NewStringObj(bytes+2, numBytes-2); Tcl_ListObjReplace(NULL, matchesObj, repair, 1, 1, &newObj); repair++; } repair = -1; } |
︙ | ︙ | |||
2406 2407 2408 2409 2410 2411 2412 | * approach). */ Tcl_DStringInit(&append); Tcl_DStringAppend(&append, pattern, p-pattern); if (pathPtr != NULL) { | | | 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 | * approach). */ Tcl_DStringInit(&append); Tcl_DStringAppend(&append, pattern, p-pattern); if (pathPtr != NULL) { (void) Tcl_GetStringFromObj(pathPtr, &length); } else { length = 0; } switch (tclPlatform) { case TCL_PLATFORM_WINDOWS: if (length == 0 && (Tcl_DStringLength(&append) == 0)) { |
︙ | ︙ | |||
2452 2453 2454 2455 2456 2457 2458 | joinedPtr = Tcl_DuplicateObj(pathPtr); if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) { /* * The current prefix must end in a separator. */ size_t len; | | | 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 | joinedPtr = Tcl_DuplicateObj(pathPtr); if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) { /* * The current prefix must end in a separator. */ size_t len; const char *joined = Tcl_GetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { Tcl_AppendToObj(joinedPtr, "/", 1); } } Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append), Tcl_DStringLength(&append)); |
︙ | ︙ | |||
2489 2490 2491 2492 2493 2494 2495 | * volume-relative path. In particular globbing in Windows shares, * when not using -dir or -path, e.g. 'glob [file join * //machine/share/subdir *]' requires adding a separator here. * This behaviour is not currently tested for in the test suite. */ size_t len; | | | 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 | * volume-relative path. In particular globbing in Windows shares, * when not using -dir or -path, e.g. 'glob [file join * //machine/share/subdir *]' requires adding a separator here. * This behaviour is not currently tested for in the test suite. */ size_t len; const char *joined = Tcl_GetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) { Tcl_AppendToObj(joinedPtr, "/", 1); } } } |
︙ | ︙ | |||
2599 2600 2601 2602 2603 2604 2605 | int Tcl_GetDeviceTypeFromStat( const Tcl_StatBuf *statPtr) { return (int) statPtr->st_rdev; } | | | | | | | | | | | | | 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 | int Tcl_GetDeviceTypeFromStat( const Tcl_StatBuf *statPtr) { return (int) statPtr->st_rdev; } long long Tcl_GetAccessTimeFromStat( const Tcl_StatBuf *statPtr) { return (long long) statPtr->st_atime; } long long Tcl_GetModificationTimeFromStat( const Tcl_StatBuf *statPtr) { return (long long) statPtr->st_mtime; } long long Tcl_GetChangeTimeFromStat( const Tcl_StatBuf *statPtr) { return (long long) statPtr->st_ctime; } unsigned long long Tcl_GetSizeFromStat( const Tcl_StatBuf *statPtr) { return (unsigned long long) statPtr->st_size; } unsigned long long Tcl_GetBlocksFromStat( const Tcl_StatBuf *statPtr) { #ifdef HAVE_STRUCT_STAT_ST_BLOCKS return (unsigned long long) statPtr->st_blocks; #else unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); return ((unsigned long long) statPtr->st_size + blksize - 1) / blksize; #endif } #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE unsigned Tcl_GetBlockSizeFromStat( const Tcl_StatBuf *statPtr) |
︙ | ︙ |
Changes to generic/tclGet.c.
1 2 3 4 5 6 7 | /* * tclGet.c -- * * This file contains functions to convert strings into other forms, like * integers or floating-point numbers or booleans, doing syntax checking * along the way. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclGet.c -- * * This file contains functions to convert strings into other forms, like * integers or floating-point numbers or booleans, doing syntax checking * along the way. * * Copyright © 1990-1993 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclGetDate.y.
1 2 3 4 5 6 7 8 9 | /* * tclGetDate.y -- * * Contains yacc grammar for parsing date and time strings. The output of * this file should be the file tclDate.c which is used directly in the * Tcl sources. Note that this file is largely obsolete in Tcl 8.5; it is * only used when doing free-form date parsing, an ill-defined process * anyway. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | /* * tclGetDate.y -- * * Contains yacc grammar for parsing date and time strings. The output of * this file should be the file tclDate.c which is used directly in the * Tcl sources. Note that this file is largely obsolete in Tcl 8.5; it is * only used when doing free-form date parsing, an ill-defined process * anyway. * * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans. * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ %parse-param {DateInfo* info} %lex-param {DateInfo* info} %define api.pure /* %error-verbose would be nice, but our token names are meaningless */ %locations %{ /* * tclDate.c -- * * This file is generated from a yacc grammar defined in the file * tclGetDate.y. It should not be edited directly. * * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans. * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclHash.c.
1 2 3 4 5 6 | /* * tclHash.c -- * * Implementation of in-memory hash tables for Tcl and Tcl-based * applications. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclHash.c -- * * Implementation of in-memory hash tables for Tcl and Tcl-based * applications. * * Copyright © 1991-1993 The Regents of the University of California. * Copyright © 1994 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclHistory.c.
1 2 3 4 5 6 7 8 | /* * tclHistory.c -- * * This module and the Tcl library file history.tcl together implement * Tcl command history. Tcl_RecordAndEval(Obj) can be called to record * commands ("events") before they are executed. Commands defined in * history.tcl may be used to perform history substitutions. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclHistory.c -- * * This module and the Tcl library file history.tcl together implement * Tcl command history. Tcl_RecordAndEval(Obj) can be called to record * commands ("events") before they are executed. Commands defined in * history.tcl may be used to perform history substitutions. * * Copyright © 1990-1993 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclIO.c.
1 2 3 4 5 6 | /* * tclIO.c -- * * This file provides the generic portions (those that are the same on * all platforms and for all channel types) of Tcl's IO facilities. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclIO.c -- * * This file provides the generic portions (those that are the same on * all platforms and for all channel types) of Tcl's IO facilities. * * Copyright © 1998-2000 Ajuba Solutions * Copyright © 1995-1997 Sun Microsystems, Inc. * Contributions from Don Porter, NIST, 2014. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
3357 3358 3359 3360 3361 3362 3363 | *---------------------------------------------------------------------- */ int TclClose( Tcl_Interp *interp, /* Interpreter for errors. */ Tcl_Channel chan) /* The channel being closed. Must not be | | > | 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 | *---------------------------------------------------------------------- */ int TclClose( Tcl_Interp *interp, /* Interpreter for errors. */ Tcl_Channel chan) /* The channel being closed. Must not be * referenced in any interpreter. May be NULL, * in which case this is a no-op. */ { CloseCallback *cbPtr; /* Iterate over close callbacks for this * channel. */ Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of real IO channel. */ int result = 0; /* Of calling FlushChannel. */ int flushcode; |
︙ | ︙ | |||
3619 3620 3621 3622 3623 3624 3625 | } /* * A user may try to call half-close from within a channel close handler. * That won't do. */ | | | 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 | } /* * 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; } |
︙ | ︙ | |||
4136 4137 4138 4139 4140 4141 4142 | */ if ((len == 1) && (UCHAR(*src) < 0xC0)) { return WriteBytes(chanPtr, src, len); } objPtr = Tcl_NewStringObj(src, len); | | | 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 | */ if ((len == 1) && (UCHAR(*src) < 0xC0)) { return WriteBytes(chanPtr, src, len); } objPtr = Tcl_NewStringObj(src, len); src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); result = WriteBytes(chanPtr, src, len); TclDecrRefCount(objPtr); return result; } /* *--------------------------------------------------------------------------- |
︙ | ︙ | |||
4188 4189 4190 4191 4192 4193 4194 | statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { return TCL_IO_FAILURE; } if (statePtr->encoding == NULL) { | | | | 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 | statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { return TCL_IO_FAILURE; } if (statePtr->encoding == NULL) { src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); return WriteBytes(chanPtr, src, srcLen); } else { src = Tcl_GetStringFromObj(objPtr, &srcLen); return WriteChars(chanPtr, src, srcLen); } } static void WillWrite( Channel *chanPtr) |
︙ | ︙ | |||
4569 4570 4571 4572 4573 4574 4575 | encoding = statePtr->encoding; /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. */ | | | 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 | encoding = statePtr->encoding; /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. */ (void)Tcl_GetStringFromObj(objPtr, &oldLength); oldFlags = statePtr->inputEncodingFlags; oldState = statePtr->inputEncodingState; oldRemoved = BUFFER_PADDING; if (bufPtr != NULL) { oldRemoved = bufPtr->nextRemoved; } |
︙ | ︙ | |||
4952 4953 4954 4955 4956 4957 4958 | bufPtr = statePtr->inQueueHead; /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. */ | | | 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 | bufPtr = statePtr->inQueueHead; /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. */ byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen); oldFlags = statePtr->inputEncodingFlags; oldRemoved = BUFFER_PADDING; oldLength = byteLen; if (bufPtr != NULL) { oldRemoved = bufPtr->nextRemoved; } |
︙ | ︙ | |||
6104 6105 6106 6107 6108 6109 6110 | * expand when converted to UTF-8 chars. This guess comes from analyzing * how many characters were produced by the previous pass. */ int factor = *factorPtr; int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; | | | 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 | * expand when converted to UTF-8 chars. This guess comes from analyzing * how many characters were produced by the previous pass. */ int factor = *factorPtr; int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; (void) Tcl_GetStringFromObj(objPtr, &numBytes); Tcl_AppendToObj(objPtr, NULL, dstLimit); if (toRead == srcLen) { size_t size; dst = TclGetStringStorage(objPtr, &size) + numBytes; dstLimit = size - numBytes; } else { |
︙ | ︙ | |||
6947 6948 6949 6950 6951 6952 6953 | * * Side effects: * May flush output on the channel. May discard queued input. * *---------------------------------------------------------------------- */ | | | | | 6948 6949 6950 6951 6952 6953 6954 6955 6956 6957 6958 6959 6960 6961 6962 6963 6964 6965 6966 6967 6968 6969 6970 6971 6972 6973 6974 6975 | * * Side effects: * May flush output on the channel. May discard queued input. * *---------------------------------------------------------------------- */ long long Tcl_Seek( Tcl_Channel chan, /* The channel on which to seek. */ long long offset, /* Offset to seek to. */ int mode) /* Relative to which location to seek? */ { Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* State info for channel */ int inputBuffered, outputBuffered; /* # bytes held in buffers. */ int result; /* Of device driver operations. */ long long curPos; /* Position on the device. */ int wasAsync; /* Was the channel nonblocking before the seek * operation? If so, must restore to * non-blocking mode after the seek. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { return -1; } |
︙ | ︙ | |||
7117 7118 7119 7120 7121 7122 7123 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | 7118 7119 7120 7121 7122 7123 7124 7125 7126 7127 7128 7129 7130 7131 7132 7133 7134 7135 7136 7137 7138 7139 7140 7141 7142 7143 | * * Side effects: * None. * *---------------------------------------------------------------------- */ long long Tcl_Tell( Tcl_Channel chan) /* The channel to return pos for. */ { Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* State info for channel */ int inputBuffered, outputBuffered; /* # bytes held in buffers. */ int result; /* Of calling device driver. */ long long curPos; /* Position on device. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { return -1; } /* * Disallow tell on dead channels -- channels that have been closed but |
︙ | ︙ | |||
7209 7210 7211 7212 7213 7214 7215 | * *--------------------------------------------------------------------------- */ int Tcl_TruncateChannel( Tcl_Channel chan, /* Channel to truncate. */ | | | 7210 7211 7212 7213 7214 7215 7216 7217 7218 7219 7220 7221 7222 7223 7224 | * *--------------------------------------------------------------------------- */ int Tcl_TruncateChannel( Tcl_Channel chan, /* Channel to truncate. */ long long length) /* Length to truncate it to. */ { Channel *chanPtr = (Channel *) chan; Tcl_DriverTruncateProc *truncateProc = Tcl_ChannelTruncateProc(chanPtr->typePtr); int result; if (truncateProc == NULL) { |
︙ | ︙ | |||
8556 8557 8558 8559 8560 8561 8562 | */ static void ChannelTimerProc( ClientData clientData) { Channel *chanPtr = (Channel *)clientData; | | | > > > > > | | | | | | | | | | | | | | > > > | 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 8591 8592 8593 8594 8595 8596 8597 8598 8599 8600 8601 8602 8603 8604 8605 8606 8607 8608 8609 8610 8611 8612 | */ 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 -- * |
︙ | ︙ | |||
8654 8655 8656 8657 8658 8659 8660 | chPtr->chanPtr = chanPtr; chPtr->nextPtr = statePtr->chPtr; statePtr->chPtr = chPtr; } /* * The remainder of the initialization below is done regardless of whether | | | 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 8677 | 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. |
︙ | ︙ | |||
9097 9098 9099 9100 9101 9102 9103 | */ int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ Tcl_Channel outChan, /* Channel to write to. */ | | | 9106 9107 9108 9109 9110 9111 9112 9113 9114 9115 9116 9117 9118 9119 9120 | */ int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ Tcl_Channel outChan, /* Channel to write to. */ long long toRead, /* Amount of data to copy, or -1 for all. */ Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ { Channel *inPtr = (Channel *) inChan; Channel *outPtr = (Channel *) outChan; ChannelState *inStatePtr, *outStatePtr; int readFlags, writeFlags; CopyState *csPtr; |
︙ | ︙ | |||
9608 9609 9610 9611 9612 9613 9614 | * Now write the buffer out. */ if (inBinary || sameEncoding) { buffer = csPtr->buffer; sizeb = size; } else { | | | 9617 9618 9619 9620 9621 9622 9623 9624 9625 9626 9627 9628 9629 9630 9631 | * Now write the buffer out. */ if (inBinary || sameEncoding) { buffer = csPtr->buffer; sizeb = size; } else { buffer = Tcl_GetStringFromObj(bufObj, &sizeb); } if (outBinary || sameEncoding) { sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb); } else { sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb); } |
︙ | ︙ | |||
10812 10813 10814 10815 10816 10817 10818 | void Tcl_SetChannelErrorInterp( Tcl_Interp *interp, /* Interp to store the data into. */ Tcl_Obj *msg) /* Error message to store. */ { Interp *iPtr = (Interp *) interp; | < < < | < > > > > > > | 10821 10822 10823 10824 10825 10826 10827 10828 10829 10830 10831 10832 10833 10834 10835 10836 10837 10838 10839 10840 10841 10842 10843 10844 10845 | 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; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
10848 10849 10850 10851 10852 10853 10854 | void Tcl_SetChannelError( Tcl_Channel chan, /* Channel to store the data into. */ Tcl_Obj *msg) /* Error message to store. */ { ChannelState *statePtr = ((Channel *) chan)->state; | < < < | < > > > > > > | 10859 10860 10861 10862 10863 10864 10865 10866 10867 10868 10869 10870 10871 10872 10873 10874 10875 10876 10877 10878 10879 10880 10881 10882 10883 | 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; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclIOCmd.c.
1 2 3 4 5 | /* * tclIOCmd.c -- * * Contains the definitions of most of the Tcl commands relating to IO. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclIOCmd.c -- * * Contains the definitions of most of the Tcl commands relating to IO. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
452 453 454 455 456 457 458 | * If requested, remove the last newline in the channel if at EOF. */ if ((charactersRead > 0) && (newline != 0)) { const char *result; size_t length; | | | 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 | * If requested, remove the last newline in the channel if at EOF. */ if ((charactersRead > 0) && (newline != 0)) { const char *result; size_t length; result = Tcl_GetStringFromObj(resultPtr, &length); if (result[length - 1] == '\n') { Tcl_SetObjLength(resultPtr, length - 1); } } Tcl_SetObjResult(interp, resultPtr); TclChannelRelease(chan); Tcl_DecrRefCount(resultPtr); |
︙ | ︙ | |||
699 700 701 702 703 704 705 | const char *string; size_t len; if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); Tcl_SetObjResult(interp, resultPtr); } | | | 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 | const char *string; size_t len; if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); Tcl_SetObjResult(interp, resultPtr); } string = Tcl_GetStringFromObj(resultPtr, &len); if ((len > 0) && (string[len - 1] == '\n')) { Tcl_SetObjLength(resultPtr, len - 1); } return TCL_ERROR; } return TCL_OK; |
︙ | ︙ | |||
979 980 981 982 983 984 985 | /* * If the last character of the result is a newline, then remove the * newline character. */ if (keepNewline == 0) { | | | 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 | /* * If the last character of the result is a newline, then remove the * newline character. */ if (keepNewline == 0) { string = Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && (string[length - 1] == '\n')) { Tcl_SetObjLength(resultPtr, length - 1); } } Tcl_SetObjResult(interp, resultPtr); return result; |
︙ | ︙ |
Changes to generic/tclIOGT.c.
1 2 3 4 5 6 | /* * tclIOGT.c -- * * Implements a generic transformation exposing the underlying API at the * script level. Contributed by Andreas Kupries. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclIOGT.c -- * * Implements a generic transformation exposing the underlying API at the * script level. Contributed by Andreas Kupries. * * Copyright © 2000 Ajuba Solutions * Copyright © 1999-2000 Andreas Kupries ([email protected]) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclIO.h" |
︙ | ︙ | |||
33 34 35 36 37 38 39 | static int TransformGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static void TransformWatchProc(ClientData instanceData, int mask); static int TransformGetFileHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static int TransformNotifyProc(ClientData instanceData, int mask); | | | | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | static int TransformGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static void TransformWatchProc(ClientData instanceData, int mask); static int TransformGetFileHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static int TransformNotifyProc(ClientData instanceData, int mask); static long long TransformWideSeekProc(ClientData instanceData, long long offset, int mode, int *errorCodePtr); /* * Forward declarations of internal procedures. Secondly the procedures for * handling and generating fileeevents. */ static void TransformChannelHandlerTimer(ClientData clientData); |
︙ | ︙ | |||
436 437 438 439 440 441 442 | break; case TRANSMIT_DOWN: if (dataPtr->self == NULL) { break; } resObj = Tcl_GetObjResult(eval); | | | | | 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 | break; case TRANSMIT_DOWN: if (dataPtr->self == NULL) { break; } resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf, resLen); break; case TRANSMIT_SELF: if (dataPtr->self == NULL) { break; } resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen); break; case TRANSMIT_IBUF: resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); ResultAdd(&dataPtr->result, resBuf, resLen); break; case TRANSMIT_NUM: /* * Interpret result as integer number. */ |
︙ | ︙ | |||
826 827 828 829 830 831 832 | * Result: * -1 if failed, the new position if successful. An output argument * contains the POSIX error code if an error occurred, or zero. * *---------------------------------------------------------------------- */ | | | | | 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 | * Result: * -1 if failed, the new position if successful. An output argument * contains the POSIX error code if an error occurred, or zero. * *---------------------------------------------------------------------- */ static long long TransformWideSeekProc( ClientData instanceData, /* The channel to manipulate. */ long long offset, /* Size of movement. */ int mode, /* How to move. */ int *errorCodePtr) /* Location of error flag. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self); const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent); Tcl_DriverWideSeekProc *parentWideSeekProc = Tcl_ChannelWideSeekProc(parentType); void *parentData = Tcl_GetChannelInstanceData(parent); if ((offset == 0) && (mode == SEEK_CUR)) { /* * This is no seek but a request to tell the caller the current * location. Simply pass the request down. */ |
︙ | ︙ |
Changes to generic/tclIORChan.c.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * tclIORChan.c -- * * This file contains the implementation of Tcl's generic channel * reflection code, which allows the implementation of Tcl channels in * Tcl code. * * Parts of this file are based on code contributed by Jean-Claude * Wippler. * * See TIP #219 for the specification of this functionality. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclIORChan.c -- * * This file contains the implementation of Tcl's generic channel * reflection code, which allows the implementation of Tcl channels in * Tcl code. * * Parts of this file are based on code contributed by Jean-Claude * Wippler. * * See TIP #219 for the specification of this functionality. * * Copyright © 2004-2005 ActiveState, a divison of Sophos * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclIO.h" |
︙ | ︙ | |||
40 41 42 43 44 45 46 | static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); #if TCL_THREADS static void ReflectThread(ClientData clientData, int action); static int ReflectEventRun(Tcl_Event *ev, int flags); static int ReflectEventDelete(Tcl_Event *ev, ClientData cd); #endif | | | > > | < | | | 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 | static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); #if TCL_THREADS static void ReflectThread(ClientData clientData, int action); static int ReflectEventRun(Tcl_Event *ev, int flags); static int ReflectEventDelete(Tcl_Event *ev, ClientData cd); #endif static long long ReflectSeekWide(ClientData clientData, long long offset, int mode, int *errorCodePtr); static int ReflectGetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int ReflectSetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, const char *newValue); static int ReflectTruncate(ClientData clientData, long long length); static void TimerRunRead(ClientData clientData); static void TimerRunWrite(ClientData 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 */ NULL, /* Close channel, clean instance data */ ReflectInput, /* Handle read request */ ReflectOutput, /* Handle write request */ NULL, 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 { |
︙ | ︙ | |||
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 | "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) | \ | > > | > | 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 | "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)) |
︙ | ︙ | |||
227 228 229 230 231 232 233 | ForwardedInput, ForwardedOutput, ForwardedSeek, ForwardedWatch, ForwardedBlock, ForwardedSetOpt, ForwardedGetOpt, | | > | 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 | 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), |
︙ | ︙ | |||
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 | 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; | > > > > > | 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 | 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; |
︙ | ︙ | |||
690 691 692 693 694 695 696 697 698 699 700 701 702 703 | clonePtr->getOptionProc = NULL; } if (!(methods & FLAG(METH_BLOCKING))) { clonePtr->blockModeProc = NULL; } if (!(methods & FLAG(METH_SEEK))) { clonePtr->wideSeekProc = NULL; } chanPtr->typePtr = clonePtr; } /* * Register the channel in the I/O system, and in our our map for 'chan | > > > | 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 | clonePtr->getOptionProc = NULL; } if (!(methods & FLAG(METH_BLOCKING))) { clonePtr->blockModeProc = NULL; } if (!(methods & FLAG(METH_SEEK))) { 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 |
︙ | ︙ | |||
1128 1129 1130 1131 1132 1133 1134 | /* *---------------------------------------------------------------------- * * ReflectClose -- * * This function is invoked when the channel is closed, to delete the | | | 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 | /* *---------------------------------------------------------------------- * * 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. * |
︙ | ︙ | |||
1161 1162 1163 1164 1165 1166 1167 | return EINVAL; } if (TclInThreadExit()) { /* * This call comes from TclFinalizeIOSystem. There are no * interpreters, and therefore we cannot call upon the handler command | | | | 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 | 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 |
︙ | ︙ | |||
1365 1366 1367 1368 1369 1370 1371 | goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } | | | 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 | goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); if ((size_t)toRead < bytec) { SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); goto invalid; } *errorCodePtr = EOK; |
︙ | ︙ | |||
1535 1536 1537 1538 1539 1540 1541 | * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ | | | | 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 | * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static long long ReflectSeekWide( ClientData clientData, long long offset, int seekMode, int *errorCodePtr) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *offObj, *baseObj; Tcl_Obj *resObj; /* Result for 'seek' */ Tcl_WideInt newLoc; |
︙ | ︙ | |||
1989 1990 1991 1992 1993 1994 1995 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Expected list with even number of " "elements, got %d element%s instead", listc, (listc == 1 ? "" : "s"))); goto error; } else { size_t len; | | | 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Expected list with even number of " "elements, got %d element%s instead", listc, (listc == 1 ? "" : "s"))); goto error; } else { size_t len; const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } goto ok; } |
︙ | ︙ | |||
2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 | Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return result; error: result = TCL_ERROR; goto stop; } /* * Helpers. ========================================================= */ /* *---------------------------------------------------------------------- | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | 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( ClientData 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? */ #ifdef 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_NewIntObj(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. ========================================================= */ /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
2364 2365 2366 2367 2368 2369 2370 | * * This is complex and ugly, and would be completely unnecessary * if we only added support for a TCL_FORBID_EXCEPTIONS flag. */ if (result != TCL_ERROR) { size_t cmdLen; | | | 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 | * * This is complex and ugly, and would be completely unnecessary * if we only added support for a TCL_FORBID_EXCEPTIONS flag. */ if (result != TCL_ERROR) { size_t cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rcPtr->interp); Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf( "chan handler returned bad code: %d", result)); Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, cmdLen); |
︙ | ︙ | |||
3035 3036 3037 3038 3039 3040 3041 | /* * Process a regular result. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ | | | 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 | /* * Process a regular result. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); if (paramPtr->input.toRead < bytec) { ForwardSetStaticError(paramPtr, msg_read_toomuch); paramPtr->input.toRead = TCL_IO_FAILURE; } else { if (bytec + 1 > 1) { memcpy(paramPtr->input.buf, bytev, bytec); |
︙ | ︙ | |||
3232 3233 3234 3235 3236 3237 3238 | sprintf(buf, "{Expected list with even number of elements, got %d %s instead}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); } else { size_t len; | | > > > > > > > > > > > > > | 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 | sprintf(buf, "{Expected list with even number of elements, got %d %s instead}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); } else { size_t len; const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } } Tcl_Release(rcPtr); break; case ForwardedTruncate: { Tcl_Obj *lenObj = Tcl_NewIntObj(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"); |
︙ | ︙ | |||
3331 3332 3333 3334 3335 3336 3337 | static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { size_t len; | | | 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 | static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { size_t len; const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; ForwardSetDynamicError(paramPtr, Tcl_Alloc(len)); memcpy(paramPtr->base.msgStr, msgStr, len); } #endif |
︙ | ︙ |
Changes to generic/tclIORTrans.c.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * tclIORTrans.c -- * * This file contains the implementation of Tcl's generic transformation * reflection code, which allows the implementation of Tcl channel * transformations in Tcl code. * * Parts of this file are based on code contributed by Jean-Claude * Wippler. * * See TIP #230 for the specification of this functionality. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclIORTrans.c -- * * This file contains the implementation of Tcl's generic transformation * reflection code, which allows the implementation of Tcl channel * transformations in Tcl code. * * Parts of this file are based on code contributed by Jean-Claude * Wippler. * * See TIP #230 for the specification of this functionality. * * Copyright © 2007-2008 ActiveState. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclIO.h" |
︙ | ︙ | |||
35 36 37 38 39 40 41 | Tcl_Interp *interp, int flags); static int ReflectInput(ClientData clientData, char *buf, int toRead, int *errorCodePtr); static int ReflectOutput(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr); static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); | | | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | Tcl_Interp *interp, int flags); static int ReflectInput(ClientData clientData, char *buf, int toRead, int *errorCodePtr); static int ReflectOutput(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr); static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); static long long ReflectSeekWide(ClientData clientData, long long offset, int mode, int *errorCodePtr); static int ReflectGetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int ReflectSetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, const char *newValue); static int ReflectHandle(ClientData clientData, int direction, |
︙ | ︙ | |||
1315 1316 1317 1318 1319 1320 1321 | * Side effects: * Allocates memory. Arbitrary, per the parent channel, and the called * scripts. * *---------------------------------------------------------------------- */ | | | | 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 | * Side effects: * Allocates memory. Arbitrary, per the parent channel, and the called * scripts. * *---------------------------------------------------------------------- */ static long long ReflectSeekWide( ClientData clientData, long long offset, int seekMode, int *errorCodePtr) { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; Channel *parent = (Channel *) rtPtr->parent; Tcl_WideInt curPos; /* Position on the device. */ |
︙ | ︙ | |||
2002 2003 2004 2005 2006 2007 2008 | * * This is complex and ugly, and would be completely unnecessary * if we only added support for a TCL_FORBID_EXCEPTIONS flag. */ if (result != TCL_ERROR) { Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv); size_t cmdLen; | | | 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 | * * This is complex and ugly, and would be completely unnecessary * if we only added support for a TCL_FORBID_EXCEPTIONS flag. */ if (result != TCL_ERROR) { Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv); size_t cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rtPtr->interp); Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf( "chan handler returned bad code: %d", result)); Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(cmd); |
︙ | ︙ | |||
2561 2562 2563 2564 2565 2566 2567 | * Sent it back to the request originator. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ | | | 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 | * Sent it back to the request originator. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { paramPtr->transform.buf = (char *)Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { |
︙ | ︙ | |||
2595 2596 2597 2598 2599 2600 2601 | * Sent it back to the request originator. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ | | | 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 | * Sent it back to the request originator. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { paramPtr->transform.buf = (char *)Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { |
︙ | ︙ | |||
2624 2625 2626 2627 2628 2629 2630 | * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ | | | 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 | * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { paramPtr->transform.buf = (char *)Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { |
︙ | ︙ | |||
2651 2652 2653 2654 2655 2656 2657 | * Sent it back to the request originator. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ | | | 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 | * Sent it back to the request originator. */ size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { paramPtr->transform.buf = (char *)Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { |
︙ | ︙ | |||
2766 2767 2768 2769 2770 2771 2772 | static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { size_t len; | | | 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 | static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { size_t len; const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; ForwardSetDynamicError(paramPtr, Tcl_Alloc(len)); memcpy(paramPtr->base.msgStr, msgStr, len); } #endif /* TCL_THREADS */ |
︙ | ︙ | |||
3051 3052 3053 3054 3055 3056 3057 | * Are we in the correct thread? */ #if TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; | | | 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 | * Are we in the correct thread? */ #if TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj, &(p.transform.size)); ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p); if (p.base.code != TCL_OK) { PassReceivedError(rtPtr->chan, &p); *errorCodePtr = EINVAL; |
︙ | ︙ | |||
3079 3080 3081 3082 3083 3084 3085 | if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } | | | 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 | if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 1; } static int |
︙ | ︙ | |||
3141 3142 3143 3144 3145 3146 3147 | Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 0; } *errorCodePtr = EOK; | | | 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 | Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 0; } *errorCodePtr = EOK; bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ } if (res < 0) { |
︙ | ︙ | |||
3194 3195 3196 3197 3198 3199 3200 | if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } | | | 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 | if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ } rtPtr->readIsDrained = 1; return 1; |
︙ | ︙ | |||
3250 3251 3252 3253 3254 3255 3256 | Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } if (op == FLUSH_WRITE) { | | | 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 | Tcl_SetChannelError(rtPtr->chan, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } if (op == FLUSH_WRITE) { bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); } else { res = 0; } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ } |
︙ | ︙ |
Changes to generic/tclIOSock.c.
1 2 3 4 5 | /* * tclIOSock.c -- * * Common routines used by all socket based channel types. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclIOSock.c -- * * Common routines used by all socket based channel types. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclIOUtil.c.
1 2 3 4 5 6 7 8 9 | /* * tclIOUtil.c -- * * Provides an interface for managing filesystems in Tcl, and also for * creating a filesystem interface in Tcl arbitrary facilities. All * filesystem operations are performed via this interface. Vince Darley * is the primary author. Other signifiant contributors are Karl * Lehenbauer, Mark Diekhans and Peter da Silva. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclIOUtil.c -- * * Provides an interface for managing filesystems in Tcl, and also for * creating a filesystem interface in Tcl arbitrary facilities. All * filesystem operations are performed via this interface. Vince Darley * is the primary author. Other signifiant contributors are Karl * Lehenbauer, Mark Diekhans and Peter da Silva. * * Copyright © 1991-1994 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 2001-2004 Vincent Darley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef _WIN32 |
︙ | ︙ | |||
520 521 522 523 524 525 526 | if (tsdPtr->cwdPathPtr == *pathPtrPtr) { return 1; } else { size_t len1, len2; const char *str1, *str2; | | | | 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 | if (tsdPtr->cwdPathPtr == *pathPtrPtr) { return 1; } else { size_t len1, len2; const char *str1, *str2; str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2); if ((len1 == len2) && !memcmp(str1, str2, len1)) { /* * The values are equal but the objects are different. Cache the * current structure in place of the old one. */ Tcl_DecrRefCount(*pathPtrPtr); |
︙ | ︙ | |||
664 665 666 667 668 669 670 | ClientData clientData) { size_t len = 0; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (cwdObj != NULL) { | | | 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 | ClientData clientData) { size_t len = 0; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (cwdObj != NULL) { str = Tcl_GetStringFromObj(cwdObj, &len); } Tcl_MutexLock(&cwdMutex); if (cwdPathPtr != NULL) { Tcl_DecrRefCount(cwdPathPtr); } if (cwdClientData != NULL) { |
︙ | ︙ | |||
1153 1154 1155 1156 1157 1158 1159 | * i.e. the representation relative to pathPtr. */ norm = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (norm != NULL) { const char *path, *mount; | | | | 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 | * i.e. the representation relative to pathPtr. */ norm = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (norm != NULL) { const char *path, *mount; mount = Tcl_GetStringFromObj(mElt, &mlen); path = Tcl_GetStringFromObj(norm, &len); if (path[len-1] == '/') { /* * Deal with the root of the volume. */ len--; } |
︙ | ︙ | |||
1334 1335 1336 1337 1338 1339 1340 | * are reserved for VFS use. These names can not conflict with real UNC * pathnames per https://msdn.microsoft.com/en-us/library/gg465305.aspx and * rfc3986's definition of reg-name. * * We check these first to avoid useless calls to the native filesystem's * normalizePathProc. */ | | | 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 | * are reserved for VFS use. These names can not conflict with real UNC * pathnames per https://msdn.microsoft.com/en-us/library/gg465305.aspx and * rfc3986's definition of reg-name. * * We check these first to avoid useless calls to the native filesystem's * normalizePathProc. */ path = Tcl_GetStringFromObj(pathPtr, &i); if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/') || (path[0] == '\\' && path[1] == '\\') ) ) { for ( i = 2; ; i++) { if (path[i] == '\0') break; if (path[i] == path[0]) break; } |
︙ | ︙ | |||
1753 1754 1755 1756 1757 1758 1759 | /* * If first character is not a BOM, append the remaining characters. * Otherwise, replace them. [Bug 3466099] */ if (Tcl_ReadChars(chan, objPtr, -1, | | | | 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 | /* * If first character is not a BOM, append the remaining characters. * Otherwise, replace them. [Bug 3466099] */ if (Tcl_ReadChars(chan, objPtr, -1, memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) { Tcl_CloseEx(interp, chan, 0); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", TclGetString(pathPtr), Tcl_PosixError(interp))); goto end; } if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) { goto end; } iPtr = (Interp *) interp; oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); string = Tcl_GetStringFromObj(objPtr, &length); /* * TIP #280: Open a frame for the evaluated script. */ iPtr->evalFlags |= TCL_EVAL_FILE; result = TclEvalEx(interp, string, length, 0, 1, NULL, string); |
︙ | ︙ | |||
1796 1797 1798 1799 1800 1801 1802 | if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } else if (result == TCL_ERROR) { /* * Record information about where the error occurred. */ | | | 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 | if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } else if (result == TCL_ERROR) { /* * Record information about where the error occurred. */ const char *pathString = Tcl_GetStringFromObj(pathPtr, &length); unsigned limit = 150; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", (overflow ? limit : (unsigned)length), pathString, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); |
︙ | ︙ | |||
1890 1891 1892 1893 1894 1895 1896 | /* * If first character is not a BOM, append the remaining characters. * Otherwise, replace them. [Bug 3466099] */ if (Tcl_ReadChars(chan, objPtr, -1, | | | 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 | /* * If first character is not a BOM, append the remaining characters. * Otherwise, replace them. [Bug 3466099] */ if (Tcl_ReadChars(chan, objPtr, -1, memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) { Tcl_CloseEx(interp, chan, 0); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", TclGetString(pathPtr), Tcl_PosixError(interp))); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } |
︙ | ︙ | |||
1949 1950 1951 1952 1953 1954 1955 | result = TclUpdateReturnInfo(iPtr); } else if (result == TCL_ERROR) { /* * Record information about where the error occurred. */ size_t length; | | | 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 | result = TclUpdateReturnInfo(iPtr); } else if (result == TCL_ERROR) { /* * Record information about where the error occurred. */ size_t length; const char *pathString = Tcl_GetStringFromObj(pathPtr, &length); const unsigned int limit = 150; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", (overflow ? limit : (unsigned int)length), pathString, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); |
︙ | ︙ | |||
2643 2644 2645 2646 2647 2648 2649 | */ retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd); Tcl_IncrRefCount(retVal); norm = TclFSNormalizeAbsolutePath(interp,retVal); if (norm != NULL) { /* | | | > | 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 | */ 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. |
︙ | ︙ | |||
2793 2794 2795 2796 2797 2798 2799 | * calling 'Tcl_FSEqualPaths', and in addition avoid a nasty * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr. */ size_t len1, len2; const char *str1, *str2; | | | | 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 | * calling 'Tcl_FSEqualPaths', and in addition avoid a nasty * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr. */ size_t len1, len2; const char *str1, *str2; str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); str2 = Tcl_GetStringFromObj(norm, &len2); if ((len1 == len2) && (strcmp(str1, str2) == 0)) { /* * The pathname values are equal so retain the old pathname * object which is probably already shared and free the * normalized pathname that was just produced. */ cdEqual: |
︙ | ︙ | |||
3006 3007 3008 3009 3010 3011 3012 | 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. */ | | | | | 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 | Tcl_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; } |
︙ | ︙ | |||
3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 | * denied removal. * * Doing the unlink is also an issue within docker containers, whose AUFS * bungles this as well, see * https://github.com/dotcloud/docker/issues/1911 * */ static int skipUnlink( Tcl_Obj *shlibFile) { /* * Unlinking is not performed in the following cases: | > > > > > > > | 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 | * denied removal. * * Doing the unlink is also an issue within docker containers, whose AUFS * bungles this as well, see * https://github.com/dotcloud/docker/issues/1911 * */ #ifdef _WIN32 #define getenv(x) _wgetenv(L##x) #define atoi(x) _wtoi(x) #else #define WCHAR char #endif static int skipUnlink( Tcl_Obj *shlibFile) { /* * Unlinking is not performed in the following cases: |
︙ | ︙ | |||
3095 3096 3097 3098 3099 3100 3101 | */ #ifdef hpux (void)shlibFile; return 1; #else | | | 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 | */ #ifdef hpux (void)shlibFile; return 1; #else WCHAR *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK"); if (skipstr && (skipstr[0] != '\0')) { return atoi(skipstr); } #ifndef TCL_TEMPLOAD_NO_UNLINK (void)shlibFile; |
︙ | ︙ | |||
3779 3780 3781 3782 3783 3784 3785 | Claim(); while (fsRecPtr != NULL) { if (fsRecPtr->fsPtr->listVolumesProc != NULL) { Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes); | > | | | | > | 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 | 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(); |
︙ | ︙ | |||
3972 3973 3974 3975 3976 3977 3978 | * length of the volume name. */ Tcl_Obj **driveNameRef) /* If not NULL, for an absolute pathname, a * place to store a pointer to an object with a * refCount of 1, and whose value is the name * of the volume. */ { size_t pathLen; | | | 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 | * length of the volume name. */ Tcl_Obj **driveNameRef) /* If not NULL, for an absolute pathname, a * place to store a pointer to an object with a * refCount of 1, and whose value is the name * of the volume. */ { size_t pathLen; const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_PathType type; type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr, driveNameRef); if (type != TCL_PATH_ABSOLUTE) { type = TclpGetNativePathType(pathPtr, driveNameLengthPtr, |
︙ | ︙ | |||
4079 4080 4081 4082 4083 4084 4085 | while (numVolumes > 0) { Tcl_Obj *vol; size_t len; const char *strVol; numVolumes--; Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol); | | | 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 | while (numVolumes > 0) { Tcl_Obj *vol; size_t len; const char *strVol; numVolumes--; Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol); strVol = Tcl_GetStringFromObj(vol,&len); if ((size_t) pathLen < len) { continue; } if (strncmp(strVol, path, len) == 0) { type = TCL_PATH_ABSOLUTE; if (filesystemPtrPtr != NULL) { *filesystemPtrPtr = fsRecPtr->fsPtr; |
︙ | ︙ | |||
4355 4356 4357 4358 4359 4360 4361 | * copyDirectoryProc is found. * *--------------------------------------------------------------------------- */ int Tcl_FSCopyDirectory( | | | < | | | | | 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 | * 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); |
︙ | ︙ | |||
4426 4427 4428 4429 4430 4431 4432 | Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL); if (cwdPtr != NULL) { const char *cwdStr, *normPathStr; size_t cwdLen, normLen; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath != NULL) { | | | | 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 | Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL); if (cwdPtr != NULL) { const char *cwdStr, *normPathStr; size_t cwdLen, normLen; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath != NULL) { normPathStr = Tcl_GetStringFromObj(normPath, &normLen); cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr, normLen) == 0)) { /* * The cwd is inside the directory to be removed. Change * the cwd to [file dirname $path]. */ |
︙ | ︙ |
Changes to generic/tclIndexObj.c.
1 2 3 4 5 6 7 | /* * tclIndexObj.c -- * * This file implements objects of type "index". This object type is used * to lookup a keyword in a table of valid values and cache the index of * the matching entry. Also provides table-based argv/argc processing. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclIndexObj.c -- * * This file implements objects of type "index". This object type is used * to lookup a keyword in a table of valid values and cache the index of * the matching entry. Also provides table-based argv/argc processing. * * Copyright © 1990-1994 The Regents of the University of California. * Copyright © 1997 Sun Microsystems, Inc. * Copyright © 2006 Sam Bromley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
611 612 613 614 615 616 617 | } result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } resultPtr = Tcl_NewListObj(0, NULL); | | | | 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 | } result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } resultPtr = Tcl_NewListObj(0, NULL); string = Tcl_GetStringFromObj(objv[2], &length); for (t = 0; t < tableObjc; t++) { elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength); /* * A prefix cannot match if it is longest. */ if (length <= elemLength) { if (TclpUtfNcmp2(elemString, string, length) == 0) { |
︙ | ︙ | |||
668 669 670 671 672 673 674 | return TCL_ERROR; } result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } | | | | 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 | return TCL_ERROR; } result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } string = Tcl_GetStringFromObj(objv[2], &length); resultString = NULL; resultLength = 0; for (t = 0; t < tableObjc; t++) { elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength); /* * First check if the prefix string matches the element. A prefix * cannot match if it is longest. */ if ((length > elemLength) || |
︙ | ︙ | |||
714 715 716 717 718 719 720 | for (i = 0; i < resultLength; i++) { if (resultString[i] != elemString[i]) { /* * Adjust in case we stopped in the middle of a UTF char. */ | | | 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 | for (i = 0; i < resultLength; i++) { if (resultString[i] != elemString[i]) { /* * Adjust in case we stopped in the middle of a UTF char. */ resultLength = Tcl_UtfPrev(&resultString[i+1], resultString) - resultString; break; } } } } if (resultLength > 0) { |
︙ | ︙ | |||
845 846 847 848 849 850 851 | if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else { | | | 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 | if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else { elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen); } flags = 0; len = TclScanElement(elementStr, elemLen, &flags); if (len != elemLen) { char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); |
︙ | ︙ | |||
895 896 897 898 899 900 901 | Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). */ | | | 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 | Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). */ elementStr = Tcl_GetStringFromObj(objv[i], &elemLen); flags = 0; len = TclScanElement(elementStr, elemLen, &flags); if (len != elemLen) { char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, |
︙ | ︙ | |||
1020 1021 1022 1023 1024 1025 1026 | srcIndex = dstIndex = 1; objc = *objcPtr-1; while (objc > 0) { curArg = objv[srcIndex]; srcIndex++; objc--; | | | 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 | srcIndex = dstIndex = 1; objc = *objcPtr-1; while (objc > 0) { curArg = objv[srcIndex]; srcIndex++; objc--; str = Tcl_GetStringFromObj(curArg, &length); if (length > 0) { c = str[1]; } else { c = 0; } /* |
︙ | ︙ | |||
1233 1234 1235 1236 1237 1238 1239 | /* Array of command-specific argument * descriptions. */ { const Tcl_ArgvInfo *infoPtr; int width, numSpaces; #define NUM_SPACES 20 static const char spaces[] = " "; | < | 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 | /* Array of command-specific argument * descriptions. */ { const Tcl_ArgvInfo *infoPtr; int width, numSpaces; #define NUM_SPACES 20 static const char spaces[] = " "; Tcl_Obj *msg; /* * First, compute the width of the widest option key, so that we can make * everything line up. */ |
︙ | ︙ | |||
1283 1284 1285 1286 1287 1288 1289 | case TCL_ARGV_INT: Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d", *((int *) infoPtr->dstPtr)); break; case TCL_ARGV_FLOAT: Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g", *((double *) infoPtr->dstPtr)); | < | 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 | case TCL_ARGV_INT: Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d", *((int *) infoPtr->dstPtr)); break; case TCL_ARGV_FLOAT: Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g", *((double *) infoPtr->dstPtr)); break; case TCL_ARGV_STRING: { char *string = *((char **) infoPtr->dstPtr); if (string != NULL) { Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: \"%s\"", string); |
︙ | ︙ |
Changes to generic/tclInt.decls.
1 2 3 4 5 6 7 | # tclInt.decls -- # # This file contains the declarations for all unsupported # functions that are exported by the Tcl library. This file # is used to generate the tclIntDecls.h, tclIntPlatDecls.h # and tclStubInit.c files # | | | | > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < | | < < < < < < < < < < < < < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 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 | # tclInt.decls -- # # This file contains the declarations for all unsupported # functions that are exported by the Tcl library. This file # is used to generate the tclIntDecls.h, tclIntPlatDecls.h # and tclStubInit.c files # # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2001 Kevin B. Kenny. All rights reserved. # Copyright © 2007 Daniel A. Steffen <[email protected]> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. library tcl # Define the unsupported generic interfaces. interface tclInt scspec EXTERN # Declare each of the functions in the unsupported internal Tcl # interface. These interfaces are allowed to changed between versions. # Use at your own risk. Note that the position of functions should not # be changed between versions to avoid gratuitous incompatibilities. declare 3 { void TclAllocateFreeObjects(void) } declare 5 { int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan) } declare 6 { void TclCleanupCommand(Command *cmdPtr) } declare 7 { size_t TclCopyAndCollapse(size_t count, const char *src, char *dst) } # TclCreatePipeline unofficially exported for use by BLT. declare 9 { int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr) } declare 10 { int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr) } declare 11 { void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr) } declare 12 { void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr) } declare 14 { int TclDumpMemoryInfo(void *clientData, int flags) } declare 16 { void TclExprFloatError(Tcl_Interp *interp, double value) } declare 22 { int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, size_t *sizePtr, int *bracePtr) } declare 23 { Proc *TclFindProc(Interp *iPtr, const char *procName) } # Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10 declare 24 { size_t TclFormatInt(char *buffer, Tcl_WideInt n) } declare 25 { void TclFreePackageInfo(Interp *iPtr) } declare 28 { Tcl_Channel TclpGetDefaultStdChannel(int type) } declare 31 { const char *TclGetExtension(const char *name) } declare 32 { int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr) } declare 38 { int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr) } declare 39 { TclObjCmdProcType TclGetObjInterpProc(void) } 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) } declare 45 { int TclHideUnsafeCommands(Tcl_Interp *interp) } declare 46 { int TclInExit(void) } declare 51 { int TclInterpInit(Tcl_Interp *interp) } declare 53 { int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, int argc, const char **argv) } declare 54 { int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 55 { Proc *TclIsProc(Command *cmdPtr) } declare 58 { Var *TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr) } declare 60 { int TclNeedSpace(const char *start, const char *end) } declare 61 { Tcl_Obj *TclNewProcBodyObj(Proc *procPtr) } declare 62 { int TclObjCommandComplete(Tcl_Obj *cmdPtr) } declare 63 { int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 64 { int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags) } declare 69 { void *TclpAlloc(size_t size) } declare 74 { void TclpFree(void *ptr) } declare 75 { unsigned long long TclpGetClicks(void) } declare 76 { unsigned long long TclpGetSeconds(void) } declare 81 { void *TclpRealloc(void *ptr, size_t size) } declare 89 { int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd) } declare 91 { void TclProcCleanupProc(Proc *procPtr) } declare 92 { int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName) } declare 93 { void TclProcDeleteProc(void *clientData) } declare 96 { int TclRenameCommand(Tcl_Interp *interp, const char *oldName, const char *newName) } declare 97 { void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr) } declare 98 { int TclServiceIdle(void) } # Removed in 9.0: #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) } declare 108 { void TclTeardownNamespace(Namespace *nsPtr) } declare 109 { int TclUpdateReturnInfo(Interp *iPtr) } declare 110 { |
︙ | ︙ | |||
455 456 457 458 459 460 461 | # defined here instead of in tcl.decls since they are not stable yet. declare 111 { void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 | # defined here instead of in tcl.decls since they are not stable yet. declare 111 { void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } declare 118 { int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo) } declare 119 { int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo) } declare 120 { Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } declare 128 { void Tcl_PopCallFrame(Tcl_Interp *interp) } declare 129 { int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame) } declare 130 { int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name) } declare 131 { void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } declare 132 { int TclpHasSockets(Tcl_Interp *interp) } declare 138 { const char *TclGetEnv(const char *name, Tcl_DString *valuePtr) } # This is used by TclX, but should otherwise be considered private declare 141 { const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData) |
︙ | ︙ | |||
605 606 607 608 609 610 611 | } declare 148 { TclHandle TclHandlePreserve(TclHandle handle) } declare 149 { void TclHandleRelease(TclHandle handle) } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 | } declare 148 { TclHandle TclHandlePreserve(TclHandle handle) } declare 149 { void TclHandleRelease(TclHandle handle) } declare 150 { int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re) } declare 151 { void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, size_t *startPtr, size_t *endPtr) } declare 152 { void TclSetLibraryPath(Tcl_Obj *pathPtr) } declare 153 { Tcl_Obj *TclGetLibraryPath(void) } declare 156 { void TclRegError(Tcl_Interp *interp, const char *msg, int status) } declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } declare 161 { int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr) } declare 162 { void TclChannelEventScriptInvoker(void *clientData, int flags) } |
︙ | ︙ | |||
690 691 692 693 694 695 696 | # New function due to TIP #33 declare 166 { int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr) } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 | # New function due to TIP #33 declare 166 { int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr) } # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { int TclpUtfNcmp2(const char *s1, const char *s2, size_t n) } declare 170 { int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 171 { int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 172 { int TclInThreadExit(void) } declare 173 { int TclUniCharMatch(const Tcl_UniChar *string, size_t strLen, const Tcl_UniChar *pattern, size_t ptnLen, int flags) } declare 175 { int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg) } declare 176 { void TclCleanupVar(Var *varPtr, Var *arrayPtr) } declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } declare 198 { int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr) } # 200-208 exported for use by the test suite [Bug 1054748] declare 200 { int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr) } declare 201 { int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, |
︙ | ︙ | |||
864 865 866 867 868 869 870 | declare 207 { int TclpObjAccess(Tcl_Obj *pathPtr, int mode) } declare 208 { Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions) } | < < < < < < < < < < | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 | declare 207 { int TclpObjAccess(Tcl_Obj *pathPtr, int mode) } declare 208 { Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions) } declare 212 { void TclpFindExecutable(const char *argv0) } declare 213 { Tcl_Obj *TclGetObjNameOfExecutable(void) } declare 214 { |
︙ | ︙ | |||
901 902 903 904 905 906 907 | void TclPopStackFrame(Tcl_Interp *interp) } # for use in tclTest.c declare 224 { TclPlatformType *TclGetPlatform(void) } | < < < < < < < < | 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 | void TclPopStackFrame(Tcl_Interp *interp) } # for use in tclTest.c declare 224 { TclPlatformType *TclGetPlatform(void) } declare 225 { Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags) } declare 226 { int TclObjBeingDeleted(Tcl_Obj *objPtr) } declare 227 { void TclSetNsPath(Namespace *nsPtr, size_t pathLength, Tcl_Namespace *pathAry[]) } declare 229 { int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index) } declare 230 { Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, |
︙ | ︙ | |||
951 952 953 954 955 956 957 | declare 234 { Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr) } declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } | < < | | | < > > | 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 | declare 234 { Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr) } declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } # TIP 542 declare 236 { void TclAppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length) } # TIP #285: Script cancellation support. declare 237 { int TclResetCancellation(Tcl_Interp *interp, int force) } # NRE functions for "rogue" extensions to exploit NRE; they will need to |
︙ | ︙ | |||
1008 1009 1010 1011 1012 1013 1014 | } declare 247 { void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble) } declare 248 { int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, | | | 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 | } declare 247 { void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble) } declare 248 { int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr) } declare 249 { char *TclDoubleDigits(double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr) } # TIP #285: Script cancellation support. |
︙ | ︙ | |||
1052 1053 1054 1055 1056 1057 1058 | 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 { | | | < < < < | < | < | < < < | | | | > > | > | < < < > | | < < > | < | < < < < < | < < < > > | < | < > | < | < < < < < < < < < < | < | | | | | | | < | < < < < < < < < | | > > > | | < < < < < < < < < < | | < < < < | < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < | | 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 | 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 { unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *lengthPtr) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. interface tclIntPlat ################################ # Platform specific functions # Removed in 9.0 #declare 0 {unix win} { # void TclWinConvertError(unsigned errCode) #} declare 1 {unix win} { int TclpCloseFile(TclFile file) } declare 2 {unix win} { Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) } declare 3 {unix win} { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } declare 4 {unix win} { void *TclWinGetTclInstance(void) } declare 5 {unix win} { int TclUnixWaitForFile(int fd, int mask, int timeout) } declare 6 {unix win} { TclFile TclpMakeFile(Tcl_Channel channel, int direction) } declare 7 {unix win} { TclFile TclpOpenFile(const char *fname, int mode) } declare 8 {unix win} { size_t TclpGetPid(Tcl_Pid pid) } declare 9 {unix win} { TclFile TclpCreateTempFile(const char *contents) } declare 11 {unix win} { void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) } declare 12 win { int TclpCloseFile_(TclFile file) } declare 13 win { Tcl_Channel TclpCreateCommandChannel_(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) } declare 14 {unix win} { int TclpCreatePipe_(TclFile *readPipe, TclFile *writePipe) } declare 15 {unix win} { int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) } declare 16 {unix win} { int TclpIsAtty(int fd) } declare 17 {unix win} { int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts) } declare 18 win { TclFile TclpMakeFile_(Tcl_Channel channel, int direction) } declare 19 unix { void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode) } declare 19 win { TclFile TclpOpenFile_(const char *fname, int mode) } declare 20 {unix win} { void TclWinAddProcess(void *hProcess, size_t id) } declare 22 {unix win} { TclFile TclpCreateTempFile_(const char *contents) } declare 24 {unix win} { char *TclWinNoBackslash(char *path) } declare 27 {unix win} { void TclWinFlushDirtyChannels(void) } declare 29 {unix win} { int TclWinCPUID(int index, int *regs) } declare 30 {unix win} { int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) } # Local Variables: # mode: tcl # End: |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2668 2669 2670 2671 2672 2673 2674 | *---------------------------------------------------------------- */ MODULE_SCOPE char *tclNativeExecutableName; MODULE_SCOPE int tclFindExecutableSearchDone; MODULE_SCOPE char *tclMemDumpFileName; MODULE_SCOPE TclPlatformType tclPlatform; | < | 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 | *---------------------------------------------------------------- */ 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. */ |
︙ | ︙ | |||
2971 2972 2973 2974 2975 2976 2977 | const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, size_t *sizePtr); | | | 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 | const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, size_t *sizePtr); MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp, const char *targetName, const char *packageName); MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *, Tcl_WideInt *); MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types); |
︙ | ︙ | |||
3060 3061 3062 3063 3064 3065 3066 | MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, size_t numBytes, Tcl_Parse *parsePtr); MODULE_SCOPE size_t TclParseAllWhiteSpace(const char *src, size_t 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); | | > > > > > > > > > > | 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 | MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, size_t numBytes, Tcl_Parse *parsePtr); MODULE_SCOPE size_t TclParseAllWhiteSpace(const char *src, size_t 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, size_t len); MODULE_SCOPE void TclpAlertNotifier(ClientData clientData); 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, void *clientData, size_t stackSize, int flags); MODULE_SCOPE size_t TclpFindVariable(const char *name, size_t *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, size_t *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); |
︙ | ︙ | |||
3105 3106 3107 3108 3109 3110 3111 | 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); | | > | | 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 | 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, |
︙ | ︙ | |||
3179 3180 3181 3182 3183 3184 3185 | const char *nameStr); MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE size_t TclUtfCount(int ch); #if TCL_UTF_MAX > 3 # define TclUtfToUCS4 Tcl_UtfToUniChar # define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1) | | < < | | < < < > | | | | | 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 | const char *nameStr); MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE size_t TclUtfCount(int ch); #if TCL_UTF_MAX > 3 # define TclUtfToUCS4 Tcl_UtfToUniChar # define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1) # define TclUCS4Prev(src, ptr) (((src) > (ptr)) ? ((src) - 1) : (src)) #else MODULE_SCOPE int TclUtfToUCS4(const char *, int *); MODULE_SCOPE int TclUniCharToUCS4(const Tcl_UniChar *, int *); MODULE_SCOPE const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *, const Tcl_UniChar *); #endif MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(void *clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE void * TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size); MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, int size, int codeSize, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); #endif MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(long long clicks); MODULE_SCOPE double TclpWideClickInMicrosec(void); #else # ifdef _WIN32 # define TCL_WIDE_CLICKS 1 MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); # define TclpWideClicksToNanoseconds(clicks) \ ((double)(clicks) * TclpWideClickInMicrosec() * 1000) # endif #endif MODULE_SCOPE long long TclpGetMicroseconds(void); MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetGlobalTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, |
︙ | ︙ | |||
4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 | MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t before, size_t after, int *indexPtr); MODULE_SCOPE size_t TclIndexDecode(int encoded, size_t endValue); /* Constants used in index value encoding routines. */ #define TCL_INDEX_END ((size_t)-2) #define TCL_INDEX_START ((size_t)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 | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 | MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t before, size_t after, int *indexPtr); MODULE_SCOPE size_t TclIndexDecode(int encoded, size_t endValue); /* Constants used in index value encoding routines. */ #define TCL_INDEX_END ((size_t)-2) #define TCL_INDEX_START ((size_t)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 |
︙ | ︙ | |||
4413 4414 4415 4416 4417 4418 4419 | * MODULE_SCOPE char * TclGetString(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 | * MODULE_SCOPE char * TclGetString(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) /* *---------------------------------------------------------------- * 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 TclFreeIntRep(Tcl_Obj *objPtr); |
︙ | ︙ | |||
4656 4657 4658 4659 4660 4661 4662 | _count = (numBytes) - _i; \ if (_i) { \ _count += Tcl_NumUtfChars((bytes) + _count, _i); \ } \ (numChars) = _count; \ } while (0); | < < < < < | 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 | _count = (numBytes) - _i; \ if (_i) { \ _count += Tcl_NumUtfChars((bytes) + _count, _i); \ } \ (numChars) = _count; \ } while (0); /* *---------------------------------------------------------------- * Macro that encapsulates the logic that determines when it is safe to * interpret a string as a byte array directly. In summary, the object must be * a byte array and must not have a string representation (as the operations * that it is used in are defined on strings, not byte arrays). Theoretically * it is possible to also be efficient in the case where the object's bytes |
︙ | ︙ | |||
4697 4698 4699 4700 4701 4702 4703 | * this macro is: * * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs, * const Tcl_UniChar *ct, unsigned long n); *---------------------------------------------------------------- */ | | | 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 | * this macro is: * * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs, * const Tcl_UniChar *ct, unsigned long n); *---------------------------------------------------------------- */ #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3) # define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) #endif /* WORDS_BIGENDIAN */ /* *---------------------------------------------------------------- * Macro used by the Tcl core to increment a namespace's export epoch * counter. The ANSI C "prototype" for this macro is: |
︙ | ︙ | |||
4726 4727 4728 4729 4730 4731 4732 | *---------------------------------------------------------------------- * * Core procedure added to libtommath for bignum manipulation. * *---------------------------------------------------------------------- */ | | | | | | | | 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 | *---------------------------------------------------------------------- * * 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); |
︙ | ︙ | |||
4848 4849 4850 4851 4852 4853 4854 | } while (0) #else /* TCL_MEM_DEBUG */ #define TclNewIntObj(objPtr, w) \ (objPtr) = Tcl_NewWideIntObj(w) #define TclNewIndexObj(objPtr, w) \ | | | 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 | } while (0) #else /* TCL_MEM_DEBUG */ #define TclNewIntObj(objPtr, w) \ (objPtr) = Tcl_NewWideIntObj(w) #define TclNewIndexObj(objPtr, w) \ (objPtr) = (((size_t)w) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : 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 */ |
︙ | ︙ | |||
5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 | #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) #define Tcl_AttemptAlloc TclpAlloc #define Tcl_AttemptRealloc TclpRealloc #define Tcl_Free TclpFree #endif #endif /* _TCLINT */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 | #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) #define Tcl_AttemptAlloc TclpAlloc #define Tcl_AttemptRealloc TclpRealloc #define Tcl_Free TclpFree #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; \ static 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.
︙ | ︙ | |||
107 108 109 110 111 112 113 | /* 32 */ EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ | | < < | < < | 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 | /* 32 */ EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* Slot 37 is reserved */ /* 38 */ EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 39 */ 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 */ /* Slot 44 is reserved */ /* 45 */ EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp); /* 46 */ EXTERN int TclInExit(void); /* Slot 47 is reserved */ /* Slot 48 is reserved */ /* Slot 49 is reserved */ |
︙ | ︙ | |||
186 187 188 189 190 191 192 | /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* 74 */ EXTERN void TclpFree(void *ptr); /* 75 */ | | | | 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* 74 */ EXTERN void TclpFree(void *ptr); /* 75 */ EXTERN unsigned long long TclpGetClicks(void); /* 76 */ EXTERN unsigned long long TclpGetSeconds(void); /* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ EXTERN void * TclpRealloc(void *ptr, size_t size); /* Slot 82 is reserved */ |
︙ | ︙ | |||
227 228 229 230 231 232 233 | /* 97 */ EXTERN void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr); /* 98 */ EXTERN int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ | | < | 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 | /* 97 */ EXTERN void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr); /* 98 */ EXTERN int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* Slot 101 is reserved */ /* 102 */ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* Slot 104 is reserved */ /* Slot 105 is reserved */ |
︙ | ︙ | |||
501 502 503 504 505 506 507 | EXTERN void TclGetSrcInfoForPc(CmdFrame *contextPtr); /* 234 */ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); | | > > | 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 | EXTERN void TclGetSrcInfoForPc(CmdFrame *contextPtr); /* 234 */ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); /* 236 */ EXTERN void TclAppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ EXTERN int TclNRInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 239 */ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, |
︙ | ︙ | |||
537 538 539 540 541 542 543 | Tcl_Obj *const *objv); /* 247 */ EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble); /* 248 */ EXTERN int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, | | | 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 | Tcl_Obj *const *objv); /* 247 */ EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble); /* 248 */ EXTERN int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr); /* 249 */ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 250 */ EXTERN void TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force); /* 251 */ |
︙ | ︙ | |||
570 571 572 573 574 575 576 | 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 */ | | | | | < < < | 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 | 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 unsigned char * TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *lengthPtr); typedef struct TclIntStubs { int magic; void *hooks; |
︙ | ︙ | |||
625 626 627 628 629 630 631 | void (*reserved30)(void); const char * (*tclGetExtension) (const char *name); /* 31 */ int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */ void (*reserved33)(void); void (*reserved34)(void); void (*reserved35)(void); void (*reserved36)(void); | | | | 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 | void (*reserved30)(void); const char * (*tclGetExtension) (const char *name); /* 31 */ int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */ void (*reserved33)(void); void (*reserved34)(void); void (*reserved35)(void); void (*reserved36)(void); void (*reserved37)(void); 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); void (*reserved44)(void); int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ int (*tclInExit) (void); /* 46 */ void (*reserved47)(void); void (*reserved48)(void); void (*reserved49)(void); void (*reserved50)(void); int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ |
︙ | ︙ | |||
663 664 665 666 667 668 669 | void (*reserved68)(void); void * (*tclpAlloc) (size_t size); /* 69 */ void (*reserved70)(void); void (*reserved71)(void); void (*reserved72)(void); void (*reserved73)(void); void (*tclpFree) (void *ptr); /* 74 */ | | | | 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 | void (*reserved68)(void); void * (*tclpAlloc) (size_t size); /* 69 */ void (*reserved70)(void); void (*reserved71)(void); void (*reserved72)(void); void (*reserved73)(void); void (*tclpFree) (void *ptr); /* 74 */ unsigned long long (*tclpGetClicks) (void); /* 75 */ unsigned long long (*tclpGetSeconds) (void); /* 76 */ void (*reserved77)(void); void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); void * (*tclpRealloc) (void *ptr, size_t size); /* 81 */ void (*reserved82)(void); void (*reserved83)(void); |
︙ | ︙ | |||
689 690 691 692 693 694 695 | 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); | | | 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 | 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); void (*reserved101)(void); void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */ int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */ void (*reserved104)(void); void (*reserved105)(void); void (*reserved106)(void); void (*reserved107)(void); void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */ |
︙ | ︙ | |||
824 825 826 827 828 829 830 | int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */ int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */ int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */ void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ | | | | < | | 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 | int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */ int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */ int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */ void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ void (*tclAppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 236 */ int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */ int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */ int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */ int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */ void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */ Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */ Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */ int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, size_t numRemoved, size_t numInserted, Tcl_Obj *const *objv); /* 246 */ void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */ int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr); /* 248 */ char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */ int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t 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 */ unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *lengthPtr); /* 259 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
917 918 919 920 921 922 923 | (tclIntStubsPtr->tclGetExtension) /* 31 */ #define TclGetFrame \ (tclIntStubsPtr->tclGetFrame) /* 32 */ /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ | | < | < | 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 | (tclIntStubsPtr->tclGetExtension) /* 31 */ #define TclGetFrame \ (tclIntStubsPtr->tclGetFrame) /* 32 */ /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* Slot 37 is reserved */ #define TclGetNamespaceForQualName \ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */ #define TclGetObjInterpProc \ (tclIntStubsPtr->tclGetObjInterpProc) /* 39 */ #define TclGetOpenMode \ (tclIntStubsPtr->tclGetOpenMode) /* 40 */ #define TclGetOriginalCommand \ (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */ #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ /* Slot 43 is reserved */ /* Slot 44 is reserved */ #define TclHideUnsafeCommands \ (tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */ #define TclInExit \ (tclIntStubsPtr->tclInExit) /* 46 */ /* Slot 47 is reserved */ /* Slot 48 is reserved */ /* Slot 49 is reserved */ |
︙ | ︙ | |||
1012 1013 1014 1015 1016 1017 1018 | (tclIntStubsPtr->tclRenameCommand) /* 96 */ #define TclResetShadowedCmdRefs \ (tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */ #define TclServiceIdle \ (tclIntStubsPtr->tclServiceIdle) /* 98 */ /* Slot 99 is reserved */ /* Slot 100 is reserved */ | < | | 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 | (tclIntStubsPtr->tclRenameCommand) /* 96 */ #define TclResetShadowedCmdRefs \ (tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */ #define TclServiceIdle \ (tclIntStubsPtr->tclServiceIdle) /* 98 */ /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* Slot 101 is reserved */ #define TclSetupEnv \ (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ /* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ |
︙ | ︙ | |||
1221 1222 1223 1224 1225 1226 1227 | (tclIntStubsPtr->tclEvalObjEx) /* 232 */ #define TclGetSrcInfoForPc \ (tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */ #define TclVarHashCreateVar \ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ | > | | 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 | (tclIntStubsPtr->tclEvalObjEx) /* 232 */ #define TclGetSrcInfoForPc \ (tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */ #define TclVarHashCreateVar \ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ #define TclAppendUnicodeToObj \ (tclIntStubsPtr->tclAppendUnicodeToObj) /* 236 */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ (tclIntStubsPtr->tclNRInterpProc) /* 238 */ #define TclNRInterpProcCore \ (tclIntStubsPtr->tclNRInterpProcCore) /* 239 */ #define TclNRRunCallbacks \ |
︙ | ︙ | |||
1262 1263 1264 1265 1266 1267 1268 | (tclIntStubsPtr->tclPtrSetVar) /* 253 */ #define TclPtrIncrObjVar \ (tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */ #define TclPtrObjMakeUpvar \ (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ | | | < < | | | | | 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 | (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 TclGetBytesFromObj \ (tclIntStubsPtr->tclGetBytesFromObj) /* 259 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) #undef Tcl_StaticLibrary #define Tcl_StaticLibrary \ (tclIntStubsPtr->tclStaticLibrary) #endif /* defined(USE_TCL_STUBS) */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLINTDECLS */ |
Changes to generic/tclIntPlatDecls.h.
︙ | ︙ | |||
37 38 39 40 41 42 43 | #endif /* * Exported function declarations: */ #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ | | < < | < < < | | | > > | | < | | > | | < < < | | > | < < < < | > | > | > > | | | > > > | < > | > | > | > | | | > | | | | < < | < < < | | | > > | | < | | > | | < < < | | > | < < < < | > | > | > | | | | | | | | | | | | | < | > | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | > | | | | | | | | > | | | | < | > < > > > | | < | | > > | | > > < > > | | | | | | | | | | | | | < | | | | | | | > | | | | | | | | > | | | | < | > < > > | > < < | | > > > | > > > | > > | | > > > | 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 | #endif /* * Exported function declarations: */ #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ /* Slot 0 is reserved */ /* 1 */ EXTERN int TclpCloseFile(TclFile file); /* 2 */ EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 3 */ EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ EXTERN void * TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 6 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ EXTERN size_t TclpGetPid(Tcl_Pid pid); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 10 is reserved */ /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* Slot 12 is reserved */ /* Slot 13 is reserved */ /* 14 */ EXTERN int TclpCreatePipe_(TclFile *readPipe, TclFile *writePipe); /* 15 */ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 16 */ EXTERN int TclpIsAtty(int fd); /* 17 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* Slot 18 is reserved */ /* 19 */ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* 20 */ EXTERN void TclWinAddProcess(void *hProcess, size_t id); /* Slot 21 is reserved */ /* 22 */ EXTERN TclFile TclpCreateTempFile_(const char *contents); /* Slot 23 is reserved */ /* 24 */ EXTERN char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* 27 */ EXTERN void TclWinFlushDirtyChannels(void); /* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(int index, int *regs); /* 30 */ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* Slot 0 is reserved */ /* 1 */ EXTERN int TclpCloseFile(TclFile file); /* 2 */ EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 3 */ EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ EXTERN void * TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 6 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ EXTERN size_t TclpGetPid(Tcl_Pid pid); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 10 is reserved */ /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 12 */ EXTERN int TclpCloseFile_(TclFile file); /* 13 */ EXTERN Tcl_Channel TclpCreateCommandChannel_(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 14 */ EXTERN int TclpCreatePipe_(TclFile *readPipe, TclFile *writePipe); /* 15 */ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 16 */ EXTERN int TclpIsAtty(int fd); /* 17 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 18 */ EXTERN TclFile TclpMakeFile_(Tcl_Channel channel, int direction); /* 19 */ EXTERN TclFile TclpOpenFile_(const char *fname, int mode); /* 20 */ EXTERN void TclWinAddProcess(void *hProcess, size_t id); /* Slot 21 is reserved */ /* 22 */ EXTERN TclFile TclpCreateTempFile_(const char *contents); /* Slot 23 is reserved */ /* 24 */ EXTERN char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* 27 */ EXTERN void TclWinFlushDirtyChannels(void); /* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(int index, int *regs); /* 30 */ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* Slot 0 is reserved */ /* 1 */ EXTERN int TclpCloseFile(TclFile file); /* 2 */ EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 3 */ EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ EXTERN void * TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 6 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ EXTERN size_t TclpGetPid(Tcl_Pid pid); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 10 is reserved */ /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* Slot 12 is reserved */ /* Slot 13 is reserved */ /* 14 */ EXTERN int TclpCreatePipe_(TclFile *readPipe, TclFile *writePipe); /* 15 */ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 16 */ EXTERN int TclpIsAtty(int fd); /* 17 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* Slot 18 is reserved */ /* 19 */ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* 20 */ EXTERN void TclWinAddProcess(void *hProcess, size_t id); /* Slot 21 is reserved */ /* 22 */ EXTERN TclFile TclpCreateTempFile_(const char *contents); /* Slot 23 is reserved */ /* 24 */ EXTERN char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* 27 */ EXTERN void TclWinFlushDirtyChannels(void); /* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(int index, int *regs); /* 30 */ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* MACOSX */ typedef struct TclIntPlatStubs { int magic; void *hooks; #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*reserved0)(void); int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ void * (*tclWinGetTclInstance) (void); /* 4 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ void (*reserved10)(void); void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ void (*reserved12)(void); void (*reserved13)(void); int (*tclpCreatePipe_) (TclFile *readPipe, TclFile *writePipe); /* 14 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */ int (*tclpIsAtty) (int fd); /* 16 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ void (*reserved18)(void); void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ void (*tclWinAddProcess) (void *hProcess, size_t id); /* 20 */ void (*reserved21)(void); TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ void (*reserved25)(void); void (*reserved26)(void); void (*tclWinFlushDirtyChannels) (void); /* 27 */ void (*reserved28)(void); int (*tclWinCPUID) (int index, int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ void (*reserved0)(void); int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ void * (*tclWinGetTclInstance) (void); /* 4 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ void (*reserved10)(void); void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile_) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel_) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ int (*tclpCreatePipe_) (TclFile *readPipe, TclFile *writePipe); /* 14 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */ int (*tclpIsAtty) (int fd); /* 16 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ TclFile (*tclpMakeFile_) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile_) (const char *fname, int mode); /* 19 */ void (*tclWinAddProcess) (void *hProcess, size_t id); /* 20 */ void (*reserved21)(void); TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ void (*reserved25)(void); void (*reserved26)(void); void (*tclWinFlushDirtyChannels) (void); /* 27 */ void (*reserved28)(void); int (*tclWinCPUID) (int index, int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ void (*reserved0)(void); int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ void * (*tclWinGetTclInstance) (void); /* 4 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ void (*reserved10)(void); void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ void (*reserved12)(void); void (*reserved13)(void); int (*tclpCreatePipe_) (TclFile *readPipe, TclFile *writePipe); /* 14 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */ int (*tclpIsAtty) (int fd); /* 16 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ void (*reserved18)(void); void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ void (*tclWinAddProcess) (void *hProcess, size_t id); /* 20 */ void (*reserved21)(void); TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ void (*reserved25)(void); void (*reserved26)(void); void (*tclWinFlushDirtyChannels) (void); /* 27 */ void (*reserved28)(void); int (*tclWinCPUID) (int index, int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* MACOSX */ } TclIntPlatStubs; extern const TclIntPlatStubs *tclIntPlatStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCL_STUBS) /* * Inline function declarations: */ #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ /* Slot 0 is reserved */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #define TclpCreateCommandChannel \ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ /* Slot 10 is reserved */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ /* Slot 12 is reserved */ /* Slot 13 is reserved */ #define TclpCreatePipe_ \ (tclIntPlatStubsPtr->tclpCreatePipe_) /* 14 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #define TclpIsAtty \ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ /* Slot 18 is reserved */ #define TclMacOSXNotifierAddRunLoopMode \ (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ /* Slot 21 is reserved */ #define TclpCreateTempFile_ \ (tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ #define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ /* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* Slot 0 is reserved */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #define TclpCreateCommandChannel \ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ /* Slot 10 is reserved */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile_ \ (tclIntPlatStubsPtr->tclpCloseFile_) /* 12 */ #define TclpCreateCommandChannel_ \ (tclIntPlatStubsPtr->tclpCreateCommandChannel_) /* 13 */ #define TclpCreatePipe_ \ (tclIntPlatStubsPtr->tclpCreatePipe_) /* 14 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #define TclpIsAtty \ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ #define TclpMakeFile_ \ (tclIntPlatStubsPtr->tclpMakeFile_) /* 18 */ #define TclpOpenFile_ \ (tclIntPlatStubsPtr->tclpOpenFile_) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ /* Slot 21 is reserved */ #define TclpCreateTempFile_ \ (tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ #define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ /* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* Slot 0 is reserved */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #define TclpCreateCommandChannel \ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ /* Slot 10 is reserved */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ /* Slot 12 is reserved */ /* Slot 13 is reserved */ #define TclpCreatePipe_ \ (tclIntPlatStubsPtr->tclpCreatePipe_) /* 14 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #define TclpIsAtty \ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ /* Slot 18 is reserved */ #define TclMacOSXNotifierAddRunLoopMode \ (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ /* Slot 21 is reserved */ #define TclpCreateTempFile_ \ (tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ #define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ /* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #define TclWinConvertWSAError Tcl_WinConvertError #define TclWinConvertError Tcl_WinConvertError #ifdef MAC_OSX_TCL /* not accessable on Win32/UNIX */ MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 16 */ MODULE_SCOPE int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 17 */ MODULE_SCOPE int TclMacOSXCopyFileAttributes(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 18 */ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); #endif #if !defined(_WIN32) # undef TclpGetPid # define TclpGetPid(pid) ((size_t)(pid)) #endif #endif /* _TCLINTPLATDECLS */ |
Changes to generic/tclInterp.c.
1 2 3 4 5 6 | /* * tclInterp.c -- * * This file implements the "interp" command which allows creation and * manipulation of Tcl interpreters from within Tcl scripts. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclInterp.c -- * * This file implements the "interp" command which allows creation and * manipulation of Tcl interpreters from within Tcl scripts. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 2004 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
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 -- * |
︙ | ︙ | |||
4593 4594 4595 4596 4597 4598 4599 | if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum Options) index) { case OPT_CMD: scriptObj = objv[i+1]; | | | | 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 | if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum Options) index) { case OPT_CMD: scriptObj = objv[i+1]; (void) Tcl_GetStringFromObj(scriptObj, &scriptLen); break; case OPT_GRAN: granObj = objv[i+1]; if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) { return TCL_ERROR; } if (gran < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "granularity must be at least 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } break; case OPT_VAL: limitObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &limitLen); if (limitLen == 0) { break; } if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) { return TCL_ERROR; } if (limit < 0) { |
︙ | ︙ | |||
4792 4793 4794 4795 4796 4797 4798 | } else { int i; size_t scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; Tcl_Time limitMoment; | | | | | | | | | | | | | | | | 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 | } else { int i; size_t scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; Tcl_Time limitMoment; Tcl_WideInt tmp; Tcl_LimitGetTime(childInterp, &limitMoment); for (i=consumedObjc ; i<objc ; i+=2) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum Options) index) { case OPT_CMD: scriptObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &scriptLen); break; case OPT_GRAN: granObj = objv[i+1]; if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) { return TCL_ERROR; } if (gran < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "granularity must be at least 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } break; case OPT_MILLI: milliObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &milliLen); if (milliLen == 0) { break; } if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) { return TCL_ERROR; } if (tmp < 0 || tmp > LONG_MAX) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "milliseconds must be between 0 and %ld", LONG_MAX)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } limitMoment.usec = ((long)tmp)*1000; break; case OPT_SEC: secObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &secLen); if (secLen == 0) { break; } if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) { return TCL_ERROR; } if (tmp < 0 || tmp > LONG_MAX) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seconds must be between 0 and %ld", LONG_MAX)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } limitMoment.sec = (long)tmp; break; } } if (milliObj != NULL || secObj != NULL) { if (milliObj != NULL) { /* * Setting -milliseconds but clearing -seconds, or resetting |
︙ | ︙ |
Changes to generic/tclLink.c.
1 2 3 4 5 6 7 8 | /* * tclLink.c -- * * This file implements linked variables (a C variable that is tied to a * Tcl variable). The idea of linked variables was first suggested by * Andreas Stolcke and this implementation is based heavily on a * prototype implementation provided by him. * | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclLink.c -- * * This file implements linked variables (a C variable that is tied to a * Tcl variable). The idea of linked variables was first suggested by * Andreas Stolcke and this implementation is based heavily on a * prototype implementation provided by him. * * Copyright © 1993 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 2008 Rene Zaumseil * Copyright © 2019 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" |
︙ | ︙ | |||
630 631 632 633 634 635 636 | SetInvalidRealFromAny( TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr) { size_t length; const char *str, *endPtr; | | | 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 | SetInvalidRealFromAny( TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr) { size_t length; const char *str, *endPtr; str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 1) && (str[0] == '.')) { objPtr->typePtr = &invalidRealType; objPtr->internalRep.doubleValue = 0.0; return TCL_OK; } if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr, TCL_PARSE_DECIMAL_ONLY) == TCL_OK) { |
︙ | ︙ | |||
675 676 677 678 679 680 681 | static int GetInvalidIntFromObj( Tcl_Obj *objPtr, int *intPtr) { size_t length; | | | 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 | static int GetInvalidIntFromObj( Tcl_Obj *objPtr, int *intPtr) { size_t length; const char *str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 0) || ((length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) { *intPtr = 0; return TCL_OK; } else if ((length == 1) && strchr("+-", str[0])) { *intPtr = (str[0] == '+'); |
︙ | ︙ | |||
893 894 895 896 897 898 899 | /* * Special cases. */ switch (linkPtr->type) { case TCL_LINK_STRING: | | | | | 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 | /* * Special cases. */ switch (linkPtr->type) { case TCL_LINK_STRING: value = Tcl_GetStringFromObj(valueObj, &valueLength); pp = (char **) linkPtr->addr; *pp = (char *)Tcl_Realloc(*pp, ++valueLength); memcpy(*pp, value, valueLength); return NULL; case TCL_LINK_CHARS: value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength); valueLength++; /* include end of string char */ if (valueLength > linkPtr->bytes) { return (char *) "wrong size of char* value"; } if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, value, valueLength); memcpy(linkPtr->addr, value, valueLength); } else { linkPtr->lastValue.c = '\0'; LinkedVar(char) = linkPtr->lastValue.c; } return NULL; case TCL_LINK_BINARY: value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength); if (valueLength != linkPtr->bytes) { return (char *) "wrong size of binary value"; } if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, value, valueLength); memcpy(linkPtr->addr, value, valueLength); } else { |
︙ | ︙ |
Changes to generic/tclListObj.c.
1 2 3 4 5 | /* * tclListObj.c -- * * This file contains functions that implement the Tcl list object type. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclListObj.c -- * * This file contains functions that implement the Tcl list object type. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 1998 Scriptics Corporation. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include <assert.h> |
︙ | ︙ | |||
536 537 538 539 540 541 542 | ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; | | | 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 | ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { *objcPtr = 0; *objvPtr = NULL; return TCL_OK; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { |
︙ | ︙ | |||
660 661 662 663 664 665 666 | } ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; | | | 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 | } ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t 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; |
︙ | ︙ | |||
835 836 837 838 839 840 841 | List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; | | | 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 | List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { *objPtrPtr = NULL; return TCL_OK; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; |
︙ | ︙ | |||
892 893 894 895 896 897 898 | List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; | | | 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 | List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { *intPtr = 0; return TCL_OK; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; |
︙ | ︙ | |||
969 970 971 972 973 974 975 | Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { size_t length; | | | 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 | Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { size_t 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); |
︙ | ︙ | |||
1780 1781 1782 1783 1784 1785 1786 | } ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; | | | 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 | } ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t 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); } |
︙ | ︙ | |||
2016 2017 2018 2019 2020 2021 2022 | Tcl_IncrRefCount(keyPtr); Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } } else { int estCount; size_t length; | | | 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 | Tcl_IncrRefCount(keyPtr); Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } } else { int estCount; size_t length; const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length); /* * Allocate enough space to hold a (Tcl_Obj *) for each * (possible) list element. */ estCount = TclMaxListLength(nextElem, length, &limit); |
︙ | ︙ | |||
2159 2160 2161 2162 2163 2164 2165 | */ flagPtr = (char *)Tcl_Alloc(numElems); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); | | | | 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 | */ flagPtr = (char *)Tcl_Alloc(numElems); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); elem = Tcl_GetStringFromObj(elemPtrs[i], &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); } bytesNeeded += numElems - 1; /* * Pass 2: copy into string rep buffer. */ start = dst = Tcl_InitStringRep(listPtr, NULL, bytesNeeded); TclOOM(dst, bytesNeeded); for (i = 0; i < numElems; i++) { flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0); elem = Tcl_GetStringFromObj(elemPtrs[i], &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; } /* Set the string length to what was actually written, the safe choice */ (void) Tcl_InitStringRep(listPtr, NULL, dst - 1 - start); |
︙ | ︙ |
Changes to generic/tclLiteral.c.
1 2 3 4 5 6 7 8 9 | /* * tclLiteral.c -- * * Implementation of the global and ByteCode-local literal tables used to * manage the Tcl objects created for literal values during compilation * of Tcl scripts. This implementation borrows heavily from the more * general hashtable implementation of Tcl hash tables that appears in * tclHash.c. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * tclLiteral.c -- * * Implementation of the global and ByteCode-local literal tables used to * manage the Tcl objects created for literal values during compilation * of Tcl scripts. This implementation borrows heavily from the more * general hashtable implementation of Tcl hash tables that appears in * tclHash.c. * * Copyright © 1997-1998 Sun Microsystems, Inc. * Copyright © 2004 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
207 208 209 210 211 212 213 | * Literals should always have UTF-8 representations... but this * is not guaranteed so we need to be careful anyway. * * https://stackoverflow.com/q/54337750/301832 */ size_t objLength; | | | 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 | * Literals should always have UTF-8 representations... but this * is not guaranteed so we need to be careful anyway. * * https://stackoverflow.com/q/54337750/301832 */ size_t objLength; const char *objBytes = Tcl_GetStringFromObj(objPtr, &objLength); if ((objLength == length) && ((length == 0) || ((objBytes[0] == bytes[0]) && (memcmp(objBytes, bytes, length) == 0)))) { /* * A literal was found: return it */ |
︙ | ︙ | |||
506 507 508 509 510 511 512 | { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *entryPtr; const char *bytes; size_t globalHash, length; | | | 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 | { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *entryPtr; const char *bytes; size_t globalHash, length; bytes = Tcl_GetStringFromObj(objPtr, &length); globalHash = (HashString(bytes, length) & globalTablePtr->mask); for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { if (entryPtr->objPtr == objPtr) { return entryPtr; } } |
︙ | ︙ | |||
567 568 569 570 571 572 573 | */ newObjPtr = Tcl_DuplicateObj(lPtr->objPtr); Tcl_IncrRefCount(newObjPtr); TclReleaseLiteral(interp, lPtr->objPtr); lPtr->objPtr = newObjPtr; | | | 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 | */ newObjPtr = Tcl_DuplicateObj(lPtr->objPtr); Tcl_IncrRefCount(newObjPtr); TclReleaseLiteral(interp, lPtr->objPtr); lPtr->objPtr = newObjPtr; bytes = Tcl_GetStringFromObj(newObjPtr, &length); localHash = HashString(bytes, length) & localTablePtr->mask; nextPtrPtr = &localTablePtr->buckets[localHash]; for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) { if (entryPtr == lPtr) { *nextPtrPtr = lPtr->nextPtr; lPtr->nextPtr = NULL; |
︙ | ︙ | |||
700 701 702 703 704 705 706 | if (localPtr->objPtr == objPtr) { found = 1; } } } if (!found) { | | | 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 | if (localPtr->objPtr == objPtr) { found = 1; } } } if (!found) { bytes = Tcl_GetStringFromObj(objPtr, &length); Tcl_Panic("%s: literal \"%.*s\" wasn't found locally", "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ return objIndex; |
︙ | ︙ | |||
829 830 831 832 833 834 835 | size_t length, index; if (iPtr == NULL) { goto done; } globalTablePtr = &iPtr->literalTable; | | | 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 | size_t length, index; if (iPtr == NULL) { goto done; } globalTablePtr = &iPtr->literalTable; bytes = Tcl_GetStringFromObj(objPtr, &length); index = HashString(bytes, length) & globalTablePtr->mask; /* * Check to see if the object is in the global literal table and remove * this reference. The object may not be in the table if it is a hidden * local literal. */ |
︙ | ︙ | |||
1001 1002 1003 1004 1005 1006 1007 | /* * Rehash all of the existing entries into the new bucket array. */ for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) { for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) { | | | 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 | /* * Rehash all of the existing entries into the new bucket array. */ for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) { for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) { bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length); index = (HashString(bytes, length) & tablePtr->mask); *oldChainPtr = entryPtr->nextPtr; bucketPtr = &tablePtr->buckets[index]; entryPtr->nextPtr = *bucketPtr; *bucketPtr = entryPtr; } |
︙ | ︙ | |||
1172 1173 1174 1175 1176 1177 1178 | size_t i, length, count = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; if (localPtr->refCount != TCL_INDEX_NONE) { | | | 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 | size_t i, length, count = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; if (localPtr->refCount != TCL_INDEX_NONE) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", "TclVerifyLocalLiteralTable", (length>60? 60 : (int) length), bytes, localPtr->refCount); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", "TclVerifyLocalLiteralTable"); |
︙ | ︙ | |||
1221 1222 1223 1224 1225 1226 1227 | size_t i, length, count = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; if (globalPtr->refCount + 1 < 2) { | | | 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 | size_t i, length, count = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; if (globalPtr->refCount + 1 < 2) { bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length); Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", "TclVerifyGlobalLiteralTable", (length>60? 60 : (int)length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", "TclVerifyGlobalLiteralTable"); |
︙ | ︙ |
Changes to generic/tclLoad.c.
1 2 3 4 5 6 | /* * tclLoad.c -- * * This file provides the generic portion (those that are the same on all * platforms) of Tcl's dynamic loading facilities. * | | | | | < < | | | | < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | /* * 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. */ 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. * 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. */ struct LoadedLibrary *nextPtr; /* Next in list of all libraries loaded into * this application process. NULL means end of * list. */ } LoadedLibrary; /* * TCL_THREADS * There is a global list of libraries that is anchored at firstLibraryPtr. * Access to this list is governed by a mutex. */ static LoadedLibrary *firstLibraryPtr = NULL; /* First in list of all libraries loaded into * this process. */ TCL_DECLARE_MUTEX(libraryMutex) /* * The following structure represents a particular library that has been * incorporated into a particular interpreter (by calling its initialization * function). There is a list of these structures for each interpreter, with * an AssocData value (key "load") for the interpreter that points to the * first library (if any). */ typedef struct InterpLibrary { LoadedLibrary *libraryPtr; /* Points to detailed information about * library. */ struct InterpLibrary *nextPtr; /* Next library in this interpreter, or NULL * for end of list. */ } InterpLibrary; /* * Prototypes for functions that are private to this file: */ static void LoadCleanupProc(ClientData clientData, Tcl_Interp *interp); |
︙ | ︙ | |||
117 118 119 120 121 122 123 | Tcl_LoadObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *target; | | | | | | | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | Tcl_LoadObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { 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; size_t len; int index, flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { "-global", "-lazy", "--", NULL |
︙ | ︙ | |||
155 156 157 158 159 160 161 | } else if (LOAD_LAZY == (enum loadOptionsEnum) index) { flags |= TCL_LOAD_LAZY; } else { break; } } if ((objc < 2) || (objc > 4)) { | | | | | | | | | | | | | | | | | | | < < | | | | | | | | | | | | | | | | | | | | | | | > | > < < < < < < | | | | | | | | | | | | | | | | | | > > > > > > > > | | < | | | | | | | | | | | | | | | | | | < < | | | | | | | > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 | } else if (LOAD_LAZY == (enum loadOptionsEnum) index) { flags |= TCL_LOAD_LAZY; } else { break; } } if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } fullFileName = TclGetString(objv[1]); Tcl_DStringInit(&pfx); Tcl_DStringInit(&initName); Tcl_DStringInit(&safeInitName); Tcl_DStringInit(&unloadName); Tcl_DStringInit(&safeUnloadName); Tcl_DStringInit(&tmp); prefix = NULL; if (objc >= 3) { prefix = TclGetString(objv[2]); if (prefix[0] == '\0') { prefix = NULL; } } if ((fullFileName[0] == 0) && (prefix == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must specify either file name or prefix", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY", NULL); code = TCL_ERROR; goto done; } /* * Figure out which interpreter we're going to load the library into. */ target = interp; if (objc == 4) { const char *childIntName = TclGetString(objv[3]); target = Tcl_GetChild(interp, childIntName); if (target == NULL) { code = TCL_ERROR; goto done; } } /* * 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 name and file match the once we're looking for. * - Its file matches, and we weren't given a name. * - Its name matches, the file name was specified as empty, and there is * only no statically loaded library with the same prefix. */ Tcl_MutexLock(&libraryMutex); defaultPtr = NULL; for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) { if (prefix == NULL) { namesMatch = 0; } else { TclDStringClear(&pfx); Tcl_DStringAppend(&pfx, prefix, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pfx)) == 0) { namesMatch = 1; } else { namesMatch = 0; } } TclDStringClear(&pfx); filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (prefix == NULL))) { break; } if (namesMatch && (fullFileName[0] == 0)) { defaultPtr = libraryPtr; } if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { /* * Can't have two different libraries loaded from the same file. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file \"%s\" is already loaded for prefix \"%s\"", fullFileName, libraryPtr->prefix)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "SPLITPERSONALITY", NULL); code = TCL_ERROR; Tcl_MutexUnlock(&libraryMutex); goto done; } } Tcl_MutexUnlock(&libraryMutex); if (libraryPtr == NULL) { libraryPtr = defaultPtr; } /* * Scan through the list of libraries already loaded in the target * interpreter. If the library we want is already loaded there, then * there's nothing for us to do. */ if (libraryPtr != NULL) { ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->libraryPtr == libraryPtr) { code = TCL_OK; goto done; } } } if (libraryPtr == NULL) { /* * The desired file isn't currently loaded, so load it. It's an error * if the desired library is a static one. */ if (fullFileName[0] == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no library with prefix \"%s\" is loaded statically", prefix)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC", NULL); code = TCL_ERROR; goto done; } /* * Figure out the prefix if it wasn't provided explicitly. */ if (prefix != NULL) { Tcl_DStringAppend(&pfx, prefix, -1); } else { Tcl_Obj *splitPtr, *pkgGuessPtr; int pElements; const char *pkgGuess; /* * Threading note - this call used to be protected by a mutex. */ /* * The platform-specific code couldn't figure out the prefix. * Make a guess by taking the last element of the file * name, stripping off any leading "lib" and/or "tcl9", and * then using all of the alphabetic and underline characters * that follow that. */ splitPtr = Tcl_FSSplitPath(objv[1], &pElements); Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr); pkgGuess = TclGetString(pkgGuessPtr); if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') && (pkgGuess[2] == 'b')) { pkgGuess += 3; } #ifdef __CYGWIN__ else if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y') && (pkgGuess[2] == 'g')) { pkgGuess += 3; } #endif /* __CYGWIN__ */ if (((pkgGuess[0] == 't') #ifdef MAC_OS_TCL || (pkgGuess[0] == 'T') #endif ) && (pkgGuess[1] == 'c') && (pkgGuess[2] == 'l') && (pkgGuess[3] == '9')) { pkgGuess += 4; } for (p = pkgGuess; *p != 0; p += offset) { offset = TclUtfToUniChar(p, &ch); if (!Tcl_UniCharIsWordChar(UCHAR(ch)) || Tcl_UniCharIsDigit(UCHAR(ch))) { break; } } if (p == pkgGuess) { Tcl_DecrRefCount(splitPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't figure out prefix for %s", fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "WHATLIBRARY", NULL); code = TCL_ERROR; goto done; } Tcl_DStringAppend(&pfx, pkgGuess, p - pkgGuess); Tcl_DecrRefCount(splitPtr); /* * Fix the capitalization in the prefix so that the first * character is in caps (or title case) but the others are all * lower-case. */ Tcl_DStringSetLength(&pfx, Tcl_UtfToTitle(Tcl_DStringValue(&pfx))); } /* * Compute the names of the two initialization functions, based on the * prefix. */ TclDStringAppendDString(&initName, &pfx); TclDStringAppendLiteral(&initName, "_Init"); TclDStringAppendDString(&safeInitName, &pfx); TclDStringAppendLiteral(&safeInitName, "_SafeInit"); TclDStringAppendDString(&unloadName, &pfx); TclDStringAppendLiteral(&unloadName, "_Unload"); TclDStringAppendDString(&safeUnloadName, &pfx); TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload"); /* * Call platform-specific code to load the library and find the two * initialization functions. */ symbols[0] = Tcl_DStringValue(&initName); symbols[1] = NULL; Tcl_MutexLock(&libraryMutex); code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc, &loadHandle); Tcl_MutexUnlock(&libraryMutex); if (code != TCL_OK) { goto done; } /* * Create a new record to describe this library. */ libraryPtr = (LoadedLibrary *)Tcl_Alloc(sizeof(LoadedLibrary)); len = strlen(fullFileName) + 1; libraryPtr->fileName = (char *)Tcl_Alloc(len); memcpy(libraryPtr->fileName, fullFileName, len); len = Tcl_DStringLength(&pfx) + 1; libraryPtr->prefix = (char *)Tcl_Alloc(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; firstLibraryPtr = libraryPtr; Tcl_MutexUnlock(&libraryMutex); /* * The Tcl_FindSymbol calls may have left a spurious error message in * the interpreter result. */ Tcl_ResetResult(interp); } /* * Invoke the library's initialization function (either the normal one or * the safe one, depending on whether or not the interpreter is safe). */ if (Tcl_IsSafe(target)) { if (libraryPtr->safeInitProc == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't use library in a safe interpreter: no" " %s_SafeInit procedure", libraryPtr->prefix)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE", NULL); code = TCL_ERROR; goto done; } code = libraryPtr->safeInitProc(target); } else { if (libraryPtr->initProc == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't attach library to interpreter: no %s_Init procedure", libraryPtr->prefix)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT", NULL); code = TCL_ERROR; goto done; } code = libraryPtr->initProc(target); } /* * Test for whether the initialization failed. If so, transfer the error * from the target interpreter to the originating one. */ |
︙ | ︙ | |||
482 483 484 485 486 487 488 | iPtr->legacyFreeProc = (void (*) (void))-1; } Tcl_TransferResult(target, code, interp); goto done; } /* | | | | | | | | | | | | | 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 | iPtr->legacyFreeProc = (void (*) (void))-1; } Tcl_TransferResult(target, code, interp); goto done; } /* * Record the fact that the library has been loaded in the target * interpreter. * * Update the proper reference count. */ Tcl_MutexLock(&libraryMutex); if (Tcl_IsSafe(target)) { libraryPtr->safeInterpRefCount++; } else { libraryPtr->interpRefCount++; } Tcl_MutexUnlock(&libraryMutex); /* * Refetch ipFirstPtr: loading the library may have introduced additional * static libraries at the head of the linked list! */ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL); ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary)); ipPtr->libraryPtr = libraryPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr); done: Tcl_DStringFree(&pfx); Tcl_DStringFree(&initName); Tcl_DStringFree(&safeInitName); Tcl_DStringFree(&unloadName); Tcl_DStringFree(&safeUnloadName); Tcl_DStringFree(&tmp); return code; } |
︙ | ︙ | |||
542 543 544 545 546 547 548 | 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. */ | | | | | | | 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 | 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, *defaultPtr; Tcl_DString pfx, tmp; Tcl_LibraryUnloadProc *unloadProc; InterpLibrary *ipFirstPtr, *ipPtr; int i, index, code, complain = 1, keepLibrary = 0; int trustedRefCount = -1, safeRefCount = -1; const char *fullFileName = ""; const char *prefix; static const char *const options[] = { "-nocomplain", "-keeplibrary", "--", NULL }; enum unloadOptionsEnum { UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST }; |
︙ | ︙ | |||
593 594 595 596 597 598 599 | i++; goto endOfForLoop; } } endOfForLoop: if ((objc-i < 1) || (objc-i > 3)) { Tcl_WrongNumArgs(interp, 1, objv, | | | | | | | | | | | | | | | | | | | | | | < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 | i++; goto endOfForLoop; } } endOfForLoop: if ((objc-i < 1) || (objc-i > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? fileName ?prefix? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { return TCL_ERROR; } fullFileName = TclGetString(objv[i]); Tcl_DStringInit(&pfx); Tcl_DStringInit(&tmp); prefix = NULL; if (objc - i >= 2) { prefix = TclGetString(objv[i+1]); if (prefix[0] == '\0') { prefix = NULL; } } if ((fullFileName[0] == 0) && (prefix == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must specify either file name or prefix", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY", NULL); code = TCL_ERROR; goto done; } /* * Figure out which interpreter we're going to load the library into. */ target = interp; if (objc - i == 3) { const char *childIntName = TclGetString(objv[i + 2]); target = Tcl_GetChild(interp, childIntName); if (target == NULL) { return TCL_ERROR; } } /* * 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 * only no statically loaded library with the same prefix. */ Tcl_MutexLock(&libraryMutex); defaultPtr = NULL; for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) { int namesMatch, filesMatch; if (prefix == NULL) { namesMatch = 0; } else { TclDStringClear(&pfx); Tcl_DStringAppend(&pfx, prefix, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pfx)) == 0) { namesMatch = 1; } else { namesMatch = 0; } } TclDStringClear(&pfx); filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (prefix == NULL))) { break; } if (namesMatch && (fullFileName[0] == 0)) { defaultPtr = libraryPtr; } if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { break; } } Tcl_MutexUnlock(&libraryMutex); if (fullFileName[0] == 0) { /* * It's an error to try unload a static library. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "library with prefix \"%s\" is loaded statically and cannot be unloaded", prefix)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC", NULL); code = TCL_ERROR; goto done; } if (libraryPtr == NULL) { /* * The DLL pointed by the provided filename has never been loaded. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file \"%s\" has never been loaded", fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", NULL); code = TCL_ERROR; goto done; } /* * Scan through the list of libraries already loaded in the target * interpreter. If the library we want is already loaded there, then we * should proceed with unloading. */ code = TCL_ERROR; if (libraryPtr != NULL) { ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->libraryPtr == libraryPtr) { code = TCL_OK; break; } } } if (code != TCL_OK) { /* * The library has not been loaded in this interpreter. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file \"%s\" has never been loaded in this interpreter", 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) { 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) { 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. */ 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--; } |
︙ | ︙ | |||
804 805 806 807 808 809 810 | } /* * The unload function executed fine. Examine the reference count to see * if we unload the DLL. */ | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < < < < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 | } /* * 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. */ if (libraryPtr->safeInterpRefCount < 0) { libraryPtr->safeInterpRefCount = 0; } } else { libraryPtr->interpRefCount--; /* * Do not let counter get negative. */ if (libraryPtr->interpRefCount < 0) { libraryPtr->interpRefCount = 0; } } trustedRefCount = libraryPtr->interpRefCount; safeRefCount = libraryPtr->safeInterpRefCount; Tcl_MutexUnlock(&libraryMutex); code = TCL_OK; if (libraryPtr->safeInterpRefCount <= 0 && libraryPtr->interpRefCount <= 0 && !keepLibrary) { /* * Unload the shared library from the application memory... */ #if defined(TCL_UNLOAD_DLLS) || defined(_WIN32) /* * 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 (libraryPtr->fileName[0] != '\0') { Tcl_MutexLock(&libraryMutex); if (Tcl_FSUnloadFile(interp, libraryPtr->loadHandle) == TCL_OK) { /* * Remove this library from the loaded library cache. */ defaultPtr = libraryPtr; if (defaultPtr == firstLibraryPtr) { firstLibraryPtr = libraryPtr->nextPtr; } else { for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) { if (libraryPtr->nextPtr == defaultPtr) { libraryPtr->nextPtr = defaultPtr->nextPtr; break; } } } /* * Remove this library from the interpreter's library cache. */ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL); ipPtr = ipFirstPtr; if (ipPtr->libraryPtr == defaultPtr) { ipFirstPtr = ipFirstPtr->nextPtr; } else { InterpLibrary *ipPrevPtr; for (ipPrevPtr = ipPtr; ipPtr != NULL; ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) { if (ipPtr->libraryPtr == defaultPtr) { ipPrevPtr->nextPtr = ipPtr->nextPtr; break; } } } Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); Tcl_Free(defaultPtr->fileName); Tcl_Free(defaultPtr->prefix); Tcl_Free(defaultPtr); Tcl_Free(ipPtr); 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: Tcl_DStringFree(&pfx); Tcl_DStringFree(&tmp); if (!complain && (code != TCL_OK)) { code = TCL_OK; Tcl_ResetResult(interp); } 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. */ 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; InterpLibrary *ipPtr, *ipFirstPtr; /* * Check to see if someone else has already reported this library as * statically loaded in the process. */ Tcl_MutexLock(&libraryMutex); for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) { if ((libraryPtr->initProc == initProc) && (libraryPtr->safeInitProc == safeInitProc) && (strcmp(libraryPtr->prefix, prefix) == 0)) { break; } } Tcl_MutexUnlock(&libraryMutex); /* * If the library is not yet recorded as being loaded statically, add it * to the list now. */ if (libraryPtr == NULL) { libraryPtr = (LoadedLibrary *)Tcl_Alloc(sizeof(LoadedLibrary)); libraryPtr->fileName = (char *)Tcl_Alloc(1); libraryPtr->fileName[0] = 0; libraryPtr->prefix = (char *)Tcl_Alloc(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) { /* * If we're loading the library into an interpreter, determine whether * it's already loaded. */ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(interp, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->libraryPtr == libraryPtr) { return; } } /* * Library isn't loaded in the current interp yet. Mark it as now being * loaded. */ ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary)); ipPtr->libraryPtr = libraryPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr); } } /* *---------------------------------------------------------------------- * * TclGetLoadedLibraries -- * * This function returns information about all of the files that are * loaded (either in a particular interpreter, or for all interpreters). * * Results: * The return value is a standard Tcl completion code. If successful, a * list of lists is placed in the interp's result. Each sublist * corresponds to one loaded file; its first element is the name of the * file (or an empty string for something that's statically loaded) and * the second element is the prefix of the library in that file. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGetLoadedLibraries( Tcl_Interp *interp, /* Interpreter in which to return information * or error message. */ const char *targetName, /* Name of target interpreter or NULL. If * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ const char *prefix) /* Prefix or NULL. If NULL, return info * for all prefixes. */ { Tcl_Interp *target; LoadedLibrary *libraryPtr; InterpLibrary *ipPtr; Tcl_Obj *resultObj, *pkgDesc[2]; if (targetName == NULL) { TclNewObj(resultObj); Tcl_MutexLock(&libraryMutex); for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) { pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, -1); pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, -1); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc)); } Tcl_MutexUnlock(&libraryMutex); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } target = Tcl_GetChild(interp, targetName); if (target == NULL) { return TCL_ERROR; } ipPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL); /* * Return information about all of the available libraries. */ if (prefix) { resultObj = NULL; for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { libraryPtr = ipPtr->libraryPtr; if (!strcmp(prefix, libraryPtr->prefix)) { resultObj = Tcl_NewStringObj(libraryPtr->fileName, -1); break; } } if (resultObj) { Tcl_SetObjResult(interp, resultObj); } return TCL_OK; } /* * Return information about only the libraries that are loaded in a given * interpreter. */ TclNewObj(resultObj); for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { libraryPtr = ipPtr->libraryPtr; pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, -1); pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, -1); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *---------------------------------------------------------------------- * * LoadCleanupProc -- * * This function is called to delete all of the InterpLibrary structures * for an interpreter when the interpreter is deleted. It gets invoked * via the Tcl AssocData mechanism. * * Results: * None. * * Side effects: * Storage for all of the InterpLibrary functions for interp get deleted. * *---------------------------------------------------------------------- */ static void LoadCleanupProc( ClientData clientData, /* Pointer to first InterpLibrary structure * for interp. */ TCL_UNUSED(Tcl_Interp *)) { InterpLibrary *ipPtr, *nextPtr; ipPtr = (InterpLibrary *)clientData; while (ipPtr != NULL) { nextPtr = ipPtr->nextPtr; Tcl_Free(ipPtr); ipPtr = nextPtr; } } /* *---------------------------------------------------------------------- * * TclFinalizeLoad -- * * This function is invoked just before the application exits. It frees * all of the LoadedLibrary structures. * * Results: * None. * * Side effects: * Memory is freed. * *---------------------------------------------------------------------- */ void TclFinalizeLoad(void) { LoadedLibrary *libraryPtr; /* * No synchronization here because there should just be one thread alive * at this point. Logically, libraryMutex should be grabbed at this point, * but the Mutexes get finalized before the call to this routine. The only * subsystem left alive at this point is the memory allocator. */ while (firstLibraryPtr != NULL) { libraryPtr = firstLibraryPtr; firstLibraryPtr = libraryPtr->nextPtr; #if defined(TCL_UNLOAD_DLLS) || defined(_WIN32) /* * 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 (libraryPtr->fileName[0] != '\0') { Tcl_FSUnloadFile(NULL, libraryPtr->loadHandle); } #endif Tcl_Free(libraryPtr->fileName); Tcl_Free(libraryPtr->prefix); Tcl_Free(libraryPtr); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclLoadNone.c.
1 2 3 4 5 6 | /* * tclLoadNone.c -- * * This procedure provides a version of the TclpDlopen for use in * systems that don't support dynamic loading; it just returns an error. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclLoadNone.c -- * * This procedure provides a version of the TclpDlopen for use in * systems that don't support dynamic loading; it just returns an error. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
48 49 50 51 52 53 54 | if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "dynamic loading is not currently available on this system", -1)); } return TCL_ERROR; } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | | | < | < | 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 | if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "dynamic loading is not currently available on this system", -1)); } return TCL_ERROR; } /* * These functions are fallbacks if we somehow determine that the platform can * do loading from memory but the user wishes to disable it. They just report * (gracefully) that they fail. */ #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE void * TclpLoadMemoryGetBuffer( TCL_UNUSED(Tcl_Interp *), TCL_UNUSED(int)) { return NULL; } MODULE_SCOPE int TclpLoadMemory( Tcl_Interp *interp, /* Used for error reporting. */ TCL_UNUSED(void *), TCL_UNUSED(int), TCL_UNUSED(int), TCL_UNUSED(Tcl_LoadHandle *), TCL_UNUSED(Tcl_FSUnloadFileProc **), TCL_UNUSED(int)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory " "is not available on this system", -1)); } return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclMain.c.
1 2 3 4 5 6 7 8 9 10 | /* * tclMain.c -- * * Main program for Tcl shells and other Tcl-based applications. * This file contains a generic main program for Tcl shells and other * Tcl-based applications. It can be used as-is for many applications, * just by supplying a different appInitProc function for each specific * application. Or, it can be used as a template for creating new main * programs for Tcl applications. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclMain.c -- * * Main program for Tcl shells and other Tcl-based applications. * This file contains a generic main program for Tcl shells and other * Tcl-based applications. It can be used as-is for many applications, * just by supplying a different appInitProc function for each specific * application. Or, it can be used as a template for creating new main * programs for Tcl applications. * * Copyright © 1988-1994 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 2000 Ajuba Solutions. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * On Windows, this file needs to be compiled twice, once with UNICODE and |
︙ | ︙ | |||
60 61 62 63 64 65 66 | /* * Declarations for various library functions and variables (don't want to * include tclPort.h here, because people might copy this file out of the Tcl * source directory to make their own modified versions). */ | < < < < < | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | /* * Declarations for various library functions and variables (don't want to * include tclPort.h here, because people might copy this file out of the Tcl * source directory to make their own modified versions). */ /* * The thread-local variables for this file's functions. */ typedef struct { Tcl_Obj *path; /* The filename of the script for *_Main() * routines to [source] as a startup script, |
︙ | ︙ | |||
512 513 514 515 516 517 518 | is.prompt = PROMPT_START; /* * The final newline is syntactically redundant, and causes some * error messages troubles deeper in, so lop it back off. */ | | | | 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 | 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); } |
︙ | ︙ | |||
773 774 775 776 777 778 779 | } Tcl_AppendToObj(commandPtr, "\n", 1); if (!TclObjCommandComplete(commandPtr)) { isPtr->prompt = PROMPT_CONTINUE; goto prompt; } isPtr->prompt = PROMPT_START; | | | 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 | } 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. |
︙ | ︙ | |||
805 806 807 808 809 810 811 | Tcl_WriteChars(chan, "\n", 1); } } else if (isPtr->tty) { Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); chan = Tcl_GetStdChannel(TCL_STDOUT); Tcl_IncrRefCount(resultPtr); | | | 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 | 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); } |
︙ | ︙ |
Changes to generic/tclNamesp.c.
1 2 3 4 5 6 7 8 9 | /* * tclNamesp.c -- * * Contains support for namespaces, which provide a separate context of * commands and global variables. The global :: namespace is the * traditional Tcl "global" scope. Other namespaces are created as * children of the global namespace. These other namespaces contain * special-purpose commands and variables for packages. * | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | /* * tclNamesp.c -- * * Contains support for namespaces, which provide a separate context of * commands and global variables. The global :: namespace is the * traditional Tcl "global" scope. Other namespaces are created as * children of the global namespace. These other namespaces contain * special-purpose commands and variables for packages. * * Copyright © 1993-1997 Lucent Technologies. * Copyright © 1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * Copyright © 2002-2005 Donal K. Fellows. * Copyright © 2006 Neil Madden. * Contributions from Don Porter, NIST, 2007. (not subject to US copyright) * * Originally implemented by * Michael J. McLennan * Bell Labs Innovations for Lucent Technologies * [email protected] * |
︙ | ︙ | |||
3129 3130 3131 3132 3133 3134 3135 | * If "arg" is already a scoped value, then return it directly. * Take care to only check for scoping in precisely the style that * [::namespace code] generates it. Anything more forgiving can have * the effect of failing in namespaces that contain their own custom " "namespace" command. [Bug 3202171]. */ | | | 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 | * If "arg" is already a scoped value, then return it directly. * Take care to only check for scoping in precisely the style that * [::namespace code] generates it. Anything more forgiving can have * the effect of failing in namespaces that contain their own custom " "namespace" command. [Bug 3202171]. */ arg = Tcl_GetStringFromObj(objv[1], &length); if (*arg==':' && length > 20 && strncmp(arg, "::namespace inscope ", 20) == 0) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } /* |
︙ | ︙ |
Changes to generic/tclNotify.c.
1 2 3 4 5 6 7 8 9 | /* * 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. * | | | | > | | | 1 2 3 4 5 6 7 8 9 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; Tcl_Free(hold); |
︙ | ︙ | |||
223 224 225 226 227 228 229 230 231 232 233 234 235 236 | */ void Tcl_SetNotifier( Tcl_NotifierProcs *notifierProcPtr) { tclNotifierHooks = *notifierProcPtr; } /* *---------------------------------------------------------------------- * * Tcl_CreateEventSource -- * | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | */ void Tcl_SetNotifier( 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 *) Tcl_Alloc(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.
1 2 3 4 5 | /* * tclOO.c -- * * This file contains the object-system core (NB: not Tcl_Obj, but ::oo) * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclOO.c -- * * This file contains the object-system core (NB: not Tcl_Obj, but ::oo) * * Copyright © 2005-2012 Donal K. Fellows * Copyright © 2017 Nathan Coulter * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" |
︙ | ︙ | |||
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 | /* * Scripted parts of TclOO. First, the main script (cannot be outside this * file). */ static const char *initScript = "package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};" "namespace eval ::oo { variable version " TCLOO_VERSION " };" "namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };"; /* "tcl_findLibrary tcloo $oo::version $oo::version" */ /* " tcloo.tcl OO_LIBRARY oo::library;"; */ /* * The scripted part of the definitions of TclOO. | > > > | 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | /* * Scripted parts of TclOO. First, the main script (cannot be outside this * file). */ static const char *initScript = #ifndef TCL_NO_DEPRECATED "package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};" #endif "package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};" "namespace eval ::oo { variable version " TCLOO_VERSION " };" "namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };"; /* "tcl_findLibrary tcloo $oo::version $oo::version" */ /* " tcloo.tcl OO_LIBRARY oo::library;"; */ /* * The scripted part of the definitions of TclOO. |
︙ | ︙ | |||
253 254 255 256 257 258 259 | * to be fully provided. */ if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) { return TCL_ERROR; } | > | > > > | 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | * to be fully provided. */ if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) { return TCL_ERROR; } #ifndef TCL_NO_DEPRECATED Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL, (void *) &tclOOStubs); #endif return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL, (void *) &tclOOStubs); } /* * ---------------------------------------------------------------------- * * TclOOGetFoundation -- |
︙ | ︙ |
Changes to generic/tclOO.decls.
1 2 3 4 5 6 7 | # tclOO.decls -- # # This file contains the declarations for all supported public functions # that are exported by the TclOO package that is embedded within the Tcl # library via the stubs table. This file is used to generate the # tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # tclOO.decls -- # # This file contains the declarations for all supported public functions # that are exported by the TclOO package that is embedded within the Tcl # library via the stubs table. This file is used to generate the # tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files. # # Copyright © 2008-2013 Donal K. Fellows. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. library tclOO ###################################################################### |
︙ | ︙ |
Changes to generic/tclOOBasic.c.
1 2 3 4 5 6 | /* * tclOOBasic.c -- * * This file contains implementations of the "simple" commands and * methods from the object-system core. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclOOBasic.c -- * * This file contains implementations of the "simple" commands and * methods from the object-system core. * * Copyright © 2005-2013 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" |
︙ | ︙ | |||
204 205 206 207 208 209 210 | */ if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName ?arg ...?"); return TCL_ERROR; } | | | 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 | */ if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName ?arg ...?"); return TCL_ERROR; } objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } |
︙ | ︙ | |||
269 270 271 272 273 274 275 | */ if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName namespaceName ?arg ...?"); return TCL_ERROR; } | | | | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 | */ if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName namespaceName ?arg ...?"); return TCL_ERROR; } objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } nsName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)+1], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "namespace name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclOOCall.c.
1 2 3 4 5 6 | /* * tclOOCall.c -- * * This file contains the method call chain management code for the * object-system core. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclOOCall.c -- * * This file contains the method call chain management code for the * object-system core. * * Copyright © 2005-2012 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" |
︙ | ︙ |
Changes to generic/tclOODefineCmds.c.
1 2 3 4 5 6 | /* * tclOODefineCmds.c -- * * This file contains the implementation of the ::oo::define command, * part of the object-system core (NB: not Tcl_Obj, but ::oo). * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclOODefineCmds.c -- * * This file contains the implementation of the ::oo::define command, * part of the object-system core (NB: not Tcl_Obj, but ::oo). * * Copyright © 2006-2013 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" |
︙ | ︙ | |||
712 713 714 715 716 717 718 | Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL); return TCL_ERROR; } if (TclOOGetDefineCmdContext(interp) == NULL) { return TCL_ERROR; } | | | 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 | Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL); return TCL_ERROR; } if (TclOOGetDefineCmdContext(interp) == NULL) { return TCL_ERROR; } soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen); if (soughtLen == 0) { goto noMatch; } hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (hPtr != NULL) { const char *nameStr = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); |
︙ | ︙ | |||
774 775 776 777 778 779 780 | static Tcl_Command FindCommand( Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { size_t length; | | | 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 | static Tcl_Command FindCommand( Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { size_t length; const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length); Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; Tcl_Command cmd, cmd2; /* * If someone is playing games, we stop playing right now. */ |
︙ | ︙ | |||
995 996 997 998 999 1000 1001 | const char *typeOfSubject) /* Part of the message, saying whether it was * an object, class or class-as-object that * was being configured. */ { size_t length; Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr) ? savedNameObj : TclOOObjectName(interp, oPtr); | | | 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 | const char *typeOfSubject) /* Part of the message, saying whether it was * an object, class or class-as-object that * was being configured. */ { size_t length; Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr) ? savedNameObj : TclOOObjectName(interp, oPtr); const char *objName = Tcl_GetStringFromObj(realNameObj, &length); unsigned limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in definition script for %s \"%.*s%s\" line %d)", typeOfSubject, (overflow ? limit : (unsigned)length), objName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); |
︙ | ︙ | |||
1546 1547 1548 1549 1550 1551 1552 | oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; | | | 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 | oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; (void)Tcl_GetStringFromObj(objv[2], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. */ method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr, PUBLIC_METHOD, NULL, objv[1], objv[2], NULL); |
︙ | ︙ | |||
1752 1753 1754 1755 1756 1757 1758 | oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; | | | 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 | oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; (void)Tcl_GetStringFromObj(objv[1], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. */ method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr, PUBLIC_METHOD, NULL, NULL, objv[1], NULL); |
︙ | ︙ |
Changes to generic/tclOOInfo.c.
1 2 3 4 5 6 | /* * tclOODefineCmds.c -- * * This file contains the implementation of the ::oo-related [info] * subcommands. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclOODefineCmds.c -- * * This file contains the implementation of the ::oo-related [info] * subcommands. * * Copyright © 2006-2011 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" |
︙ | ︙ |
Changes to generic/tclOOMethod.c.
1 2 3 4 5 | /* * tclOOMethod.c -- * * This file contains code to create and manage methods. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclOOMethod.c -- * * This file contains code to create and manage methods. * * Copyright © 2005-2011 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" |
︙ | ︙ | |||
1013 1014 1015 1016 1017 1018 1019 | /* * Check if the variable is one we want to resolve at all (i.e. whether it * is in the list provided by the user). If not, we mustn't do anything * either. */ | | | | | | | 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 | /* * Check if the variable is one we want to resolve at all (i.e. whether it * is in the list provided by the user). If not, we mustn't do anything * either. */ varName = Tcl_GetStringFromObj(infoPtr->variableObj, &varLen); if (contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr != NULL) { FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr->privateVariables) { match = Tcl_GetStringFromObj(privateVar->variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { variableObj = privateVar->fullNameObj; cacheIt = 0; goto gotMatch; } } FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr->variables) { match = Tcl_GetStringFromObj(variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 0; goto gotMatch; } } } else { FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) { match = Tcl_GetStringFromObj(privateVar->variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { variableObj = privateVar->fullNameObj; cacheIt = 1; goto gotMatch; } } FOREACH(variableObj, contextPtr->oPtr->variables) { match = Tcl_GetStringFromObj(variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 1; goto gotMatch; } } } return NULL; |
︙ | ︙ | |||
1183 1184 1185 1186 1187 1188 1189 | TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/) /* We pull the method name out of context instead of from argument */ { size_t nameLen, objectNameLen; CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const char *objectName, *kindName, *methodName = | | | | 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 | TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/) /* We pull the method name out of context instead of from argument */ { size_t nameLen, objectNameLen; CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const char *objectName, *kindName, *methodName = Tcl_GetStringFromObj(mPtr->namePtr, &nameLen); Object *declarerPtr; if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; kindName = "object"; } else { if (mPtr->declaringClassPtr == NULL) { Tcl_Panic("method not declared in class or object"); } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" method \"%.*s%s\" line %d)", kindName, ELLIPSIFY(objectName, objectNameLen), ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp))); } |
︙ | ︙ | |||
1228 1229 1230 1231 1232 1233 1234 | if (mPtr->declaringClassPtr == NULL) { Tcl_Panic("method not declared in class or object"); } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } | | | 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 | if (mPtr->declaringClassPtr == NULL) { Tcl_Panic("method not declared in class or object"); } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" constructor line %d)", kindName, ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp))); } static void |
︙ | ︙ | |||
1258 1259 1260 1261 1262 1263 1264 | if (mPtr->declaringClassPtr == NULL) { Tcl_Panic("method not declared in class or object"); } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } | | | 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 | if (mPtr->declaringClassPtr == NULL) { Tcl_Panic("method not declared in class or object"); } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" destructor line %d)", kindName, ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp))); } /* |
︙ | ︙ |
Changes to generic/tclOOStubLib.c.
︙ | ︙ | |||
31 32 33 34 35 36 37 | MODULE_SCOPE const char * TclOOInitializeStubs( Tcl_Interp *interp, const char *version) { int exact = 0; | | > > > > | > | 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 | MODULE_SCOPE const char * TclOOInitializeStubs( Tcl_Interp *interp, const char *version) { int exact = 0; const char *packageName = "tcl::oo"; const char *errMsg = NULL; TclOOStubs *stubsPtr = NULL; const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &stubsPtr); if (actualVersion == NULL) { packageName = "TclOO"; actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &stubsPtr); if (actualVersion == NULL) { return NULL; } } if (stubsPtr == NULL) { errMsg = "missing stub table pointer"; } else { tclOOStubsPtr = stubsPtr; if (stubsPtr->hooks) { tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs; |
︙ | ︙ |
Changes to generic/tclObj.c.
1 2 3 4 5 6 | /* * tclObj.c -- * * This file contains Tcl object-related functions that are used by many * Tcl commands. * | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * tclObj.c -- * * This file contains Tcl object-related functions that are used by many * Tcl commands. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 1999 Scriptics Corporation. * Copyright © 2001 ActiveState Corporation. * Copyright © 2005 Kevin B. Kenny. All rights reserved. * Copyright © 2007 Daniel A. Steffen <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" |
︙ | ︙ | |||
617 618 619 620 621 622 623 | */ /* * First compute the range of the word within the script. (Is there a * better way which doesn't shimmer?) */ | | | 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 | */ /* * First compute the range of the word within the script. (Is there a * better way which doesn't shimmer?) */ (void)Tcl_GetStringFromObj(objPtr, &length); end = start + length; /* First char after the word */ /* * Then compute the table slice covering the range of the word. */ while (*wordCLLast >= 0 && *wordCLLast < end) { |
︙ | ︙ | |||
1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 | * Side effects: * May call the object's updateStringProc to update the string * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetString( Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { if (objPtr->bytes == NULL) { /* | > | 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 | * Side effects: * May call the object's updateStringProc to update the string * representation from the internal representation. * *---------------------------------------------------------------------- */ #undef Tcl_GetString char * Tcl_GetString( Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { if (objPtr->bytes == NULL) { /* |
︙ | ︙ | |||
1616 1617 1618 1619 1620 1621 1622 | } return objPtr->bytes; } /* *---------------------------------------------------------------------- * | | > | | 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 | } return objPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_GetStringFromObj/TclGetStringFromObj -- * * Returns the string representation's byte array pointer and length for * an object. * * Results: * Returns a pointer to the string representation of objPtr. If lengthPtr * isn't NULL, the length of the string representation is stored at * *lengthPtr. The byte array referenced by the returned pointer must not * be modified by the caller. Furthermore, the caller must copy the bytes * if they need to retain them since the object's string rep can change * as a result of other operations. * * Side effects: * May call the object's updateStringProc to update the string * representation from the internal representation. * *---------------------------------------------------------------------- */ #undef TclGetStringFromObj char * TclGetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ int *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { if (objPtr->bytes == NULL) { |
︙ | ︙ | |||
1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 | } } if (lengthPtr != NULL) { *lengthPtr = (objPtr->length < INT_MAX)? objPtr->length: INT_MAX; } return objPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_InitStringRep -- * * This function is called in several configurations to provide all | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | } } if (lengthPtr != NULL) { *lengthPtr = (objPtr->length < INT_MAX)? objPtr->length: INT_MAX; } return objPtr->bytes; } #undef Tcl_GetStringFromObj char * Tcl_GetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ size_t *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { if (objPtr->bytes == NULL) { /* * Note we do not check for objPtr->typePtr == NULL. An invariant * of a properly maintained Tcl_Obj is that at least one of * objPtr->bytes and objPtr->typePtr must not be NULL. If broken * extensions fail to maintain that invariant, we can crash here. */ if (objPtr->typePtr->updateStringProc == NULL) { /* * Those Tcl_ObjTypes which choose not to define an * updateStringProc must be written in such a way that * (objPtr->bytes) never becomes NULL. */ Tcl_Panic("UpdateStringProc should not be invoked for type %s", objPtr->typePtr->name); } objPtr->typePtr->updateStringProc(objPtr); if (objPtr->bytes == NULL || objPtr->bytes[objPtr->length] != '\0') { Tcl_Panic("UpdateStringProc for type '%s' " "failed to create a valid string rep", objPtr->typePtr->name); } } if (lengthPtr != NULL) { #if TCL_MAJOR_VERSION > 8 *lengthPtr = objPtr->length; #else *lengthPtr = ((size_t)(unsigned)(objPtr->length + 1)) - 1; #endif } return objPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_InitStringRep -- * * This function is called in several configurations to provide all |
︙ | ︙ | |||
2004 2005 2006 2007 2008 2009 2010 | if (ParseBoolean(objPtr) == TCL_OK) { return TCL_OK; } badBoolean: if (interp != NULL) { size_t length; | | | | 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 | if (ParseBoolean(objPtr) == TCL_OK) { return TCL_OK; } badBoolean: if (interp != NULL) { size_t length; const char *str = Tcl_GetStringFromObj(objPtr, &length); Tcl_Obj *msg; TclNewLiteralStringObj(msg, "expected boolean value but got \""); Tcl_AppendLimitedToObj(msg, str, length, 50, ""); Tcl_AppendToObj(msg, "\"", -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL); } return TCL_ERROR; } static int ParseBoolean( Tcl_Obj *objPtr) /* The object to parse/convert. */ { int newBool; char lowerCase[6]; size_t i, length; const char *str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 0) || (length > 5)) { /* * Longest valid boolean string rep. is "false". */ return TCL_ERROR; |
︙ | ︙ | |||
2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 | } return TCL_ERROR; } *intPtr = (int) l; return TCL_OK; #endif } /* *---------------------------------------------------------------------- * * SetIntFromAny -- * * Attempts to force the internal representation for a Tcl object to | > | 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 | } return TCL_ERROR; } *intPtr = (int) l; return TCL_OK; #endif } /* *---------------------------------------------------------------------- * * SetIntFromAny -- * * Attempts to force the internal representation for a Tcl object to |
︙ | ︙ | |||
3864 3865 3866 3867 3868 3869 3870 | TCL_HASH_TYPE TclHashObjKey( TCL_UNUSED(Tcl_HashTable *), void *keyPtr) /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; | < | > | 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 | TCL_HASH_TYPE TclHashObjKey( TCL_UNUSED(Tcl_HashTable *), void *keyPtr) /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; size_t length; const char *string = Tcl_GetStringFromObj(objPtr, &length); TCL_HASH_TYPE result = 0; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose * the one below (multiply by 9 and add new character) because of the |
︙ | ︙ |
Changes to generic/tclOptimize.c.
1 2 3 4 5 | /* * tclOptimize.c -- * * This file contains the bytecode optimizer. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclOptimize.c -- * * This file contains the bytecode optimizer. * * Copyright © 2013 Donal Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
229 230 231 232 233 234 235 | blank = size + InstLength(nextInst); } else if (nextInst == INST_STR_CONCAT1 && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); size_t numBytes; | | | | 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 | blank = size + InstLength(nextInst); } else if (nextInst == INST_STR_CONCAT1 && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); size_t numBytes; (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { blank = size + InstLength(nextInst); } } break; case INST_PUSH4: if (nextInst == INST_POP) { blank = size + 1; } else if (nextInst == INST_STR_CONCAT1 && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt4AtPtr(currentInstPtr + 1)); size_t numBytes; (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { blank = size + InstLength(nextInst); } } break; case INST_LNOT: |
︙ | ︙ |
Changes to generic/tclPanic.c.
1 2 3 4 5 6 7 | /* * tclPanic.c -- * * Source code for the "Tcl_Panic" library procedure for Tcl; individual * applications will probably call Tcl_SetPanicProc() to set an * application-specific panic procedure. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclPanic.c -- * * Source code for the "Tcl_Panic" library procedure for Tcl; individual * applications will probably call Tcl_SetPanicProc() to set an * application-specific panic procedure. * * Copyright © 1988-1993 The Regents of the University of California. * Copyright © 1994 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #if defined(_WIN32) || defined(__CYGWIN__) |
︙ | ︙ | |||
37 38 39 40 41 42 43 | * * Side effects: * Sets the panicProc variable. * *---------------------------------------------------------------------- */ | | | | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | * * Side effects: * Sets the panicProc variable. * *---------------------------------------------------------------------- */ const char * Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *proc) { panicProc = proc; return Tcl_InitSubsystems(); } /* *---------------------------------------------------------------------- * * Tcl_Panic -- * |
︙ | ︙ |
Changes to generic/tclParse.c.
1 2 3 4 5 6 7 | /* * tclParse.c -- * * This file contains functions that parse Tcl scripts. They do so in a * general-purpose fashion that can be used for many different purposes, * including compilation, direct execution, code analysis, etc. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclParse.c -- * * This file contains functions that parse Tcl scripts. They do so in a * general-purpose fashion that can be used for many different purposes, * including compilation, direct execution, code analysis, etc. * * Copyright © 1997 Sun Microsystems, Inc. * Copyright © 1998-2000 Ajuba Solutions. * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
786 787 788 789 790 791 792 | size_t *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be * written. At most 4 bytes will be written there. */ { const char *p = src+1; | | | 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 | size_t *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be * written. At most 4 bytes will be written there. */ { const char *p = src+1; int unichar; int result; size_t count; char buf[4] = ""; if (numBytes == 0) { if (readPtr != NULL) { *readPtr = 0; |
︙ | ︙ | |||
933 934 935 936 937 938 939 | * We have to convert here in case the user has put a backslash in * front of a multi-byte utf-8 character. While this means nothing * special, we shouldn't break up a correct utf-8 character. [Bug * #217987] test subst-3.2 */ if (Tcl_UtfCharComplete(p, numBytes - 1)) { | | | | | 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 | * We have to convert here in case the user has put a backslash in * front of a multi-byte utf-8 character. While this means nothing * special, we shouldn't break up a correct utf-8 character. [Bug * #217987] test subst-3.2 */ if (Tcl_UtfCharComplete(p, numBytes - 1)) { count = TclUtfToUCS4(p, &unichar) + 1; /* +1 for '\' */ } else { char utfBytes[8]; memcpy(utfBytes, p, numBytes - 1); utfBytes[numBytes - 1] = '\0'; count = TclUtfToUCS4(utfBytes, &unichar) + 1; } result = unichar; break; } done: if (readPtr != NULL) { |
︙ | ︙ | |||
2196 2197 2198 2199 2200 2201 2202 | && (tokenPtr->start[1] == '\n')) { if (isLiteral) { size_t clPos; if (result == 0) { clPos = 0; } else { | | | 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 | && (tokenPtr->start[1] == '\n')) { if (isLiteral) { size_t clPos; if (result == 0) { clPos = 0; } else { (void)Tcl_GetStringFromObj(result, &clPos); } if (numCL >= maxNumCL) { maxNumCL *= 2; clPosition = (int *)Tcl_Realloc(clPosition, maxNumCL * sizeof(int)); } |
︙ | ︙ | |||
2472 2473 2474 2475 2476 2477 2478 | int TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { size_t length; | | | 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 | int TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { size_t length; const char *script = Tcl_GetStringFromObj(objPtr, &length); return CommandComplete(script, length); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclPathObj.c.
1 2 3 4 5 6 7 | /* * tclPathObj.c -- * * This file contains the implementation of Tcl's "path" object type used * to represent and manipulate a general (virtual) filesystem entity in * an efficient manner. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclPathObj.c -- * * This file contains the implementation of Tcl's "path" object type used * to represent and manipulate a general (virtual) filesystem entity in * an efficient manner. * * Copyright © 2003 Vince Darley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclFileSystem.h" |
︙ | ︙ | |||
208 209 210 211 212 213 214 | size_t curLen; if (retVal == NULL) { const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } | | | 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | size_t curLen; if (retVal == NULL) { const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } (void)Tcl_GetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } dirSep += 2; oldDirSep = dirSep; if (dirSep[0] != 0 && dirSep[1] == '.') { goto again; |
︙ | ︙ | |||
234 235 236 237 238 239 240 | if (retVal == NULL) { const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } | | | 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | if (retVal == NULL) { const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } (void)Tcl_GetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { linkObj = Tcl_FSLink(retVal, NULL, 0); /* Safety check in case driver caused sharing */ |
︙ | ︙ | |||
265 266 267 268 269 270 271 | /* * We need to follow this link which is relative * to retVal's directory. This means concatenating * the link onto the directory of the path so far. */ const char *path = | | | | | | 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 | /* * We need to follow this link which is relative * to retVal's directory. This means concatenating * the link onto the directory of the path so far. */ const char *path = Tcl_GetStringFromObj(retVal, &curLen); while (curLen-- > 0) { if (IsSeparatorOrNull(path[curLen])) { break; } } /* * We want the trailing slash. */ Tcl_SetObjLength(retVal, curLen+1); Tcl_AppendObjToObj(retVal, linkObj); TclDecrRefCount(linkObj); linkStr = Tcl_GetStringFromObj(retVal, &curLen); } else { /* * Absolute link. */ TclDecrRefCount(retVal); if (Tcl_IsShared(linkObj)) { retVal = Tcl_DuplicateObj(linkObj); TclDecrRefCount(linkObj); } else { retVal = linkObj; } linkStr = Tcl_GetStringFromObj(retVal, &curLen); /* * Convert to forward-slashes on windows. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { size_t i; for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { linkStr[i] = '/'; } } } } } else { linkStr = Tcl_GetStringFromObj(retVal, &curLen); } /* * Either way, we now remove the last path element (but * not the first character of the path). */ |
︙ | ︙ | |||
381 382 383 384 385 386 387 | /* * Ensure a windows drive like C:/ has a trailing separator. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { size_t len; | | | 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 | /* * Ensure a windows drive like C:/ has a trailing separator. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { size_t len; const char *path = Tcl_GetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { if (Tcl_IsShared(retVal)) { TclDecrRefCount(retVal); retVal = Tcl_DuplicateObj(retVal); Tcl_IncrRefCount(retVal); } |
︙ | ︙ | |||
555 556 557 558 559 560 561 | * it. If so, the 'dirname' would be a joining of the main * part with the dirname of the joined-on bit. We could handle * that special case here, but we don't, and instead just use * the standardPath code. */ size_t numBytes; | | | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 | * it. If so, the 'dirname' would be a joining of the main * part with the dirname of the joined-on bit. We could handle * that special case here, but we don't, and instead just use * the standardPath code. */ size_t numBytes; const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } /* * If the joined-on bit is empty, then [file dirname] is * documented to return all but the last non-empty element |
︙ | ︙ | |||
592 593 594 595 596 597 598 | * Check if the joined-on bit has any directory delimiters in * it. If so, the 'tail' would be only the part following the * last delimiter. We could handle that special case here, but * we don't, and instead just use the standardPath code. */ size_t numBytes; | | | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 | * Check if the joined-on bit has any directory delimiters in * it. If so, the 'tail' would be only the part following the * last delimiter. We could handle that special case here, but * we don't, and instead just use the standardPath code. */ size_t numBytes; const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } /* * If the joined-on bit is empty, then [file tail] is * documented to return the last non-empty element |
︙ | ︙ | |||
621 622 623 624 625 626 627 | } case TCL_PATH_EXTENSION: return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { const char *fileName, *extension; size_t length; | | | 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | } case TCL_PATH_EXTENSION: return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { const char *fileName, *extension; size_t length; fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { /* * There is no extension so the root is the same as the * path we were given. */ |
︙ | ︙ | |||
673 674 675 676 677 678 679 | resultPtr = NULL; if (portion == TCL_PATH_EXTENSION) { return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { size_t length; const char *fileName, *extension; | | | 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 | resultPtr = NULL; if (portion == TCL_PATH_EXTENSION) { return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { size_t length; const char *fileName, *extension; fileName = Tcl_GetStringFromObj(pathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { Tcl_IncrRefCount(pathPtr); return pathPtr; } else { Tcl_Obj *root = Tcl_NewStringObj(fileName, length - strlen(extension)); |
︙ | ︙ | |||
864 865 866 867 868 869 870 | /* if forceRelative - second path is relative */ type = forceRelative ? TCL_PATH_RELATIVE : TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; size_t len; | | | 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 | /* if forceRelative - second path is relative */ type = forceRelative ? TCL_PATH_RELATIVE : TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; size_t len; str = Tcl_GetStringFromObj(tailObj, &len); if (len == 0) { /* * This happens if we try to handle the root volume '/'. * There's no need to return a special path object, when * the base itself is just fine! */ |
︙ | ︙ | |||
936 937 938 939 940 941 942 | int driveNameLength; size_t strEltLen, length; Tcl_PathType type; char *strElt, *ptr; Tcl_Obj *driveName = NULL; Tcl_Obj *elt = objv[i]; | | | 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 | int driveNameLength; size_t strEltLen, length; Tcl_PathType type; char *strElt, *ptr; Tcl_Obj *driveName = NULL; Tcl_Obj *elt = objv[i]; strElt = Tcl_GetStringFromObj(elt, &strEltLen); driveNameLength = 0; /* if forceRelative - all paths excepting first one are relative */ type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE : TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* * Zero out the current result. |
︙ | ︙ | |||
1033 1034 1035 1036 1037 1038 1039 | * We need to perform a more complex operation here. */ noQuickReturn: if (res == NULL) { TclNewObj(res); } | | | 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 | * We need to perform a more complex operation here. */ noQuickReturn: if (res == NULL) { TclNewObj(res); } ptr = Tcl_GetStringFromObj(res, &length); /* * Strip off any './' before a tilde, unless this is the beginning of * the path. */ if (length > 0 && strEltLen > 0 && (strElt[0] == '.') && |
︙ | ︙ | |||
1078 1079 1080 1081 1082 1083 1084 | res = Tcl_DuplicateObj(res); Tcl_IncrRefCount(res); } } if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); | | | 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 | res = Tcl_DuplicateObj(res); Tcl_IncrRefCount(res); } } if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); (void)Tcl_GetStringFromObj(res, &length); } Tcl_SetObjLength(res, length + strlen(strElt)); ptr = TclGetString(res) + length; for (; *strElt != '\0'; strElt++) { if (*strElt == separator) { while (strElt[1] == separator) { |
︙ | ︙ | |||
1347 1348 1349 1350 1351 1352 1353 | * 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 * intrep produce the same results; that is, bugward compatibility. If * we need to fix that bug here, it needs fixing in TclJoinPath() too. */ | | | 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 | * 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 * intrep produce the same results; that is, bugward compatibility. If * we need to fix that bug here, it needs fixing in TclJoinPath() too. */ bytes = Tcl_GetStringFromObj(tail, &length); if (length == 0) { Tcl_AppendToObj(copy, "/", 1); } else { TclpNativeJoinPath(copy, bytes); } return copy; } |
︙ | ︙ | |||
1407 1408 1409 1410 1411 1412 1413 | * better test than the '!= sep' might be to simply check if 'cwd' is a * root volume. * * Note that if we get this wrong, we will strip off either too much or * too little below, leading to wrong answers returned by glob. */ | | | | 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 | * better test than the '!= sep' might be to simply check if 'cwd' is a * root volume. * * Note that if we get this wrong, we will strip off either too much or * too little below, leading to wrong answers returned by glob. */ tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the * Windows special case? Perhaps we should just check if cwd is a root * volume. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (tempStr[cwdLen-1] != '/') { cwdLen++; } break; case TCL_PLATFORM_WINDOWS: if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') { cwdLen++; } break; } tempStr = Tcl_GetStringFromObj(pathPtr, &len); return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); } /* *--------------------------------------------------------------------------- * |
︙ | ︙ | |||
1653 1654 1655 1656 1657 1658 1659 | Tcl_Interp *interp, Tcl_Obj *pathPtr) { Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { size_t len; | | | 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 | Tcl_Interp *interp, Tcl_Obj *pathPtr) { Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { size_t len; const char *orig = Tcl_GetStringFromObj(transPtr, &len); char *result = (char *)Tcl_Alloc(len+1); memcpy(result, orig, len+1); TclDecrRefCount(transPtr); return result; } |
︙ | ︙ | |||
1713 1714 1715 1716 1717 1718 1719 | dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); if (dir == NULL) { return NULL; } /* TODO: Figure out why this is needed. */ TclGetString(pathPtr); | | | | 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 | dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); if (dir == NULL) { return NULL; } /* TODO: Figure out why this is needed. */ TclGetString(pathPtr); (void)Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { copy = AppendPath(dir, fsPathPtr->normPathPtr); } else { copy = Tcl_DuplicateObj(dir); } Tcl_IncrRefCount(dir); Tcl_IncrRefCount(copy); /* * We now own a reference on both 'dir' and 'copy' */ (void) Tcl_GetStringFromObj(dir, &cwdLen); /* Normalize the combined string. */ if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) { /* * If the "tail" part has components (like /../) that cause the * combined path to need more complete normalizing, call on the |
︙ | ︙ | |||
1809 1810 1811 1812 1813 1814 1815 | fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { size_t cwdLen; Tcl_Obj *copy; copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); | | | 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 | fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { size_t cwdLen; Tcl_Obj *copy; copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); cwdLen += (TclGetString(copy)[cwdLen] == '/'); /* * Normalize the combined string, but only starting after the end * of the previously normalized 'dir'. This should be much faster! */ |
︙ | ︙ | |||
2147 2148 2149 2150 2151 2152 2153 | if (firstPtr == secondPtr) { return 1; } if (firstPtr == NULL || secondPtr == NULL) { return 0; } | | | | | | 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 | if (firstPtr == secondPtr) { return 1; } if (firstPtr == NULL || secondPtr == NULL) { return 0; } firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) { return 1; } /* * Try the most thorough, correct method of comparing fully normalized * paths. */ tempErrno = Tcl_GetErrno(); firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr); secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr); Tcl_SetErrno(tempErrno); if (firstPtr == NULL || secondPtr == NULL) { return 0; } firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)); } /* *--------------------------------------------------------------------------- * * SetFsPathFromAny -- |
︙ | ︙ | |||
2221 2222 2223 2224 2225 2226 2227 | * We remove any trailing directory separator. * * However, the split/join routines are quite complex, and one has to make * sure not to break anything on Unix or Win (fCmd.test, fileName.test and * cmdAH.test exercise most of the code). */ | | | 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 | * We remove any trailing directory separator. * * However, the split/join routines are quite complex, and one has to make * sure not to break anything on Unix or Win (fCmd.test, fileName.test and * cmdAH.test exercise most of the code). */ name = Tcl_GetStringFromObj(pathPtr, &len); /* * Handle tilde substitutions, if needed. */ if (len && name[0] == '~') { Tcl_DString temp; |
︙ | ︙ | |||
2478 2479 2480 2481 2482 2483 2484 | copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr); if (Tcl_IsShared(copy)) { copy = Tcl_DuplicateObj(copy); } Tcl_IncrRefCount(copy); /* Steal copy's string rep */ | | | 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 | copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr); if (Tcl_IsShared(copy)) { copy = Tcl_DuplicateObj(copy); } Tcl_IncrRefCount(copy); /* Steal copy's string rep */ pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; TclInitStringRep(copy, NULL, 0); TclDecrRefCount(copy); } /* *--------------------------------------------------------------------------- |
︙ | ︙ | |||
2538 2539 2540 2541 2542 2543 2544 | * It is somewhat unusual to reach this code path without the object * being of fsPathType. However, we do our best to deal with the * situation. */ size_t len; | | | 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 | * It is somewhat unusual to reach this code path without the object * being of fsPathType. However, we do our best to deal with the * situation. */ size_t len; (void) Tcl_GetStringFromObj(pathPtr, &len); if (len == 0) { /* * We reject the empty path "". */ return -1; } |
︙ | ︙ |
Changes to generic/tclPipe.c.
1 2 3 4 5 6 | /* * tclPipe.c -- * * This file contains the generic portion of the command channel driver * as well as various utility routines used in managing subprocesses. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclPipe.c -- * * This file contains the generic portion of the command channel driver * as well as various utility routines used in managing subprocesses. * * Copyright © 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclPkg.c.
1 2 3 4 5 6 | /* * tclPkg.c -- * * This file implements package and version control for Tcl via the * "package" command and a few C APIs. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclPkg.c -- * * This file implements package and version control for Tcl via the * "package" command and a few C APIs. * * Copyright © 1996 Sun Microsystems, Inc. * Copyright © 2006 Andreas Kupries <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * TIP #268. * Heavily rewritten to handle the extend version numbers, and extended * package requirements. |
︙ | ︙ | |||
1178 1179 1180 1181 1182 1183 1184 | Tcl_Free(argv3i); return TCL_OK; } pkgPtr = (Package *)Tcl_GetHashValue(hPtr); } else { pkgPtr = FindPackage(interp, argv2); } | | | 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 | Tcl_Free(argv3i); return TCL_OK; } pkgPtr = (Package *)Tcl_GetHashValue(hPtr); } else { pkgPtr = FindPackage(interp, argv2); } argv3 = Tcl_GetStringFromObj(objv[3], &length); for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; prevPtr = availPtr, availPtr = availPtr->nextPtr) { if (CheckVersionAndConvert(interp, availPtr->version, &avi, NULL) != TCL_OK) { Tcl_Free(argv3i); return TCL_ERROR; |
︙ | ︙ | |||
1225 1226 1227 1228 1229 1230 1231 | pkgPtr->availPtr = availPtr; } else { availPtr->nextPtr = prevPtr->nextPtr; prevPtr->nextPtr = availPtr; } } if (iPtr->scriptFile) { | | | | 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 | pkgPtr->availPtr = availPtr; } else { availPtr->nextPtr = prevPtr->nextPtr; prevPtr->nextPtr = availPtr; } } if (iPtr->scriptFile) { argv4 = Tcl_GetStringFromObj(iPtr->scriptFile, &length); DupBlock(availPtr->pkgIndex, argv4, length + 1); } argv4 = Tcl_GetStringFromObj(objv[4], &length); DupBlock(availPtr->script, argv4, length + 1); break; } case PKG_NAMES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; |
︙ | ︙ | |||
1405 1406 1407 1408 1409 1410 1411 | Tcl_SetObjResult(interp, Tcl_NewStringObj(iPtr->packageUnknown, -1)); } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { Tcl_Free(iPtr->packageUnknown); } | | | 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 | Tcl_SetObjResult(interp, Tcl_NewStringObj(iPtr->packageUnknown, -1)); } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { Tcl_Free(iPtr->packageUnknown); } argv2 = Tcl_GetStringFromObj(objv[2], &length); if (argv2[0] == 0) { iPtr->packageUnknown = NULL; } else { DupBlock(iPtr->packageUnknown, argv2, length+1); } } else { Tcl_WrongNumArgs(interp, 2, objv, "?command?"); |
︙ | ︙ | |||
2070 2071 2072 2073 2074 2075 2076 | * available. */ { Tcl_Obj *result = Tcl_GetObjResult(interp); int i; size_t length; for (i = 0; i < reqc; i++) { | | | 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 | * available. */ { Tcl_Obj *result = Tcl_GetObjResult(interp); int i; size_t length; for (i = 0; i < reqc; i++) { const char *v = Tcl_GetStringFromObj(reqv[i], &length); if ((length & 0x1) && (v[length/2] == '-') && (strncmp(v, v+((length+1)/2), length/2) == 0)) { Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2)); } else { Tcl_AppendPrintfToObj(result, " %s", v); } |
︙ | ︙ |
Changes to generic/tclPkgConfig.c.
1 2 3 4 | /* * tclPkgConfig.c -- * * This file contains the configuration information to embed into the tcl | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclPkgConfig.c -- * * This file contains the configuration information to embed into the tcl * library. * * Copyright © 2002 Andreas Kupries <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* Note, the definitions in this module are influenced by the following C * preprocessor macros: |
︙ | ︙ | |||
105 106 107 108 109 110 111 112 | /* 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}, {"docdir,runtime", CFG_RUNTIME_DOCDIR}, {"dllfile,runtime", CFG_RUNTIME_DLLFILE}, | > < > | 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | /* 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}, {"docdir,runtime", CFG_RUNTIME_DOCDIR}, #if !defined(STATIC_BUILD) {"dllfile,runtime", CFG_RUNTIME_DLLFILE}, #endif /* Installation paths to various stuff */ {"libdir,install", CFG_INSTALL_LIBDIR}, {"bindir,install", CFG_INSTALL_BINDIR}, {"scriptdir,install", CFG_INSTALL_SCRDIR}, {"includedir,install", CFG_INSTALL_INCDIR}, |
︙ | ︙ |
Changes to generic/tclPlatDecls.h.
︙ | ︙ | |||
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | # if defined(_UNICODE) typedef wchar_t TCHAR; # else typedef char TCHAR; # endif # define _TCHAR_DEFINED #endif /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: */ | > > > > > > > > < | > > > > < > | < > > > | > > > | > > | < | > | < > | 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 | # if defined(_UNICODE) typedef wchar_t TCHAR; # else typedef char TCHAR; # endif # define _TCHAR_DEFINED #endif #ifndef MODULE_SCOPE # ifdef __cplusplus # define MODULE_SCOPE extern "C" # else # define MODULE_SCOPE extern # endif #endif /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: */ /* Slot 0 is reserved */ /* 1 */ EXTERN int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 2 */ EXTERN void Tcl_MacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* 3 */ EXTERN void Tcl_WinConvertError(unsigned errCode); typedef struct TclPlatStubs { int magic; void *hooks; void (*reserved0)(void); int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */ void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */ void (*tcl_WinConvertError) (unsigned errCode); /* 3 */ } TclPlatStubs; extern const TclPlatStubs *tclPlatStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCL_STUBS) /* * Inline function declarations: */ /* Slot 0 is reserved */ #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #define Tcl_MacOSXNotifierAddRunLoopMode \ (tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */ #define Tcl_WinConvertError \ (tclPlatStubsPtr->tcl_WinConvertError) /* 3 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #ifdef _WIN32 # undef Tcl_CreateFileHandler # undef Tcl_DeleteFileHandler # undef Tcl_GetOpenFile #endif #ifndef MAC_OSX_TCL # undef Tcl_MacOSXOpenVersionedBundleResources # undef Tcl_MacOSXNotifierAddRunLoopMode #endif #if defined(USE_TCL_STUBS) && defined(_WIN32) && !defined(TCL_NO_DEPRECATED) #define Tcl_WinUtfToTChar(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ (TCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr))) #define Tcl_WinTCharToUtf(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))) #endif #endif /* _TCLPLATDECLS */ |
Changes to generic/tclPosixStr.c.
1 2 3 4 5 6 | /* * tclPosixStr.c -- * * This file contains procedures that generate strings corresponding to * various POSIX-related codes, such as errno and signals. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclPosixStr.c -- * * This file contains procedures that generate strings corresponding to * various POSIX-related codes, such as errno and signals. * * Copyright © 1991-1994 The Regents of the University of California. * Copyright © 1994-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclPreserve.c.
1 2 3 4 5 6 7 | /* * tclPreserve.c -- * * This file contains a collection of functions that are used to make * sure that widget records and other data structures aren't reallocated * when there are nested functions that depend on their existence. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclPreserve.c -- * * This file contains a collection of functions that are used to make * sure that widget records and other data structures aren't reallocated * when there are nested functions that depend on their existence. * * Copyright © 1991-1994 The Regents of the University of California. * Copyright © 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclProc.c.
1 2 3 4 5 6 | /* * tclProc.c -- * * This file contains routines that implement Tcl procedures, including * the "proc" and "uplevel" commands. * | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclProc.c -- * * This file contains routines that implement Tcl procedures, including * the "proc" and "uplevel" commands. * * Copyright © 1987-1993 The Regents of the University of California. * Copyright © 1994-1998 Sun Microsystems, Inc. * Copyright © 2004-2006 Miguel Sofer * Copyright © 2007 Daniel A. Steffen <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" |
︙ | ︙ | |||
348 349 350 351 352 353 354 | procArgs++; } /* * The argument list is just "args"; check the body */ | | | 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 | procArgs++; } /* * The argument list is just "args"; check the body */ procBody = Tcl_GetStringFromObj(objv[3], &numBytes); if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) { goto done; } /* * The body is just spaces: link the compileProc */ |
︙ | ︙ | |||
443 444 445 446 447 448 449 | */ if (Tcl_IsShared(bodyPtr)) { const char *bytes; size_t length; Tcl_Obj *sharedBodyPtr = bodyPtr; | | | 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 | */ if (Tcl_IsShared(bodyPtr)) { const char *bytes; size_t length; Tcl_Obj *sharedBodyPtr = bodyPtr; bytes = Tcl_GetStringFromObj(bodyPtr, &length); bodyPtr = Tcl_NewStringObj(bytes, length); /* * TIP #280. * Ensure that the continuation line data for the original body is * not lost and applies to the new body as well. */ |
︙ | ︙ | |||
534 535 536 537 538 539 540 | Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } | | | 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 | Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength); /* * Check that the formal parameter name is a scalar. */ argnamei = argname; argnamelast = (nameLength > 0) ? (argname + nameLength - 1) : argname; |
︙ | ︙ | |||
597 598 599 600 601 602 603 | /* * Compare the default value if any. */ if (localPtr->defValuePtr != NULL) { size_t tmpLength, valueLength; | | | | 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 | /* * Compare the default value if any. */ if (localPtr->defValuePtr != NULL) { size_t tmpLength, valueLength; const char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr, &tmpLength); const char *value = Tcl_GetStringFromObj(fieldValues[1], &valueLength); if ((valueLength != tmpLength) || memcmp(value, tmpPtr, tmpLength) != 0 ) { Tcl_Obj *errorObj = Tcl_ObjPrintf( "procedure \"%s\": formal parameter \"", procName); Tcl_AppendObjToObj(errorObj, fieldValues[0]); |
︙ | ︙ | |||
2030 2031 2032 2033 2034 2035 2036 | Tcl_Interp *interp, /* The interpreter in which the procedure was * called. */ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { unsigned int overflow, limit = 60; size_t nameLen; | | | 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 | Tcl_Interp *interp, /* The interpreter in which the procedure was * called. */ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { unsigned int overflow, limit = 60; size_t nameLen; const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (procedure \"%.*s%s\" line %d)", (int)(overflow ? limit :nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } |
︙ | ︙ | |||
2701 2702 2703 2704 2705 2706 2707 | Tcl_Interp *interp, /* The interpreter in which the procedure was * called. */ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { unsigned int overflow, limit = 60; size_t nameLen; | | | 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 | Tcl_Interp *interp, /* The interpreter in which the procedure was * called. */ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { unsigned int overflow, limit = 60; size_t nameLen; const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (lambda term \"%.*s%s\" line %d)", (int)(overflow ? limit : nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } |
︙ | ︙ |
Changes to generic/tclProcess.c.
1 2 3 4 5 6 | /* * tclProcess.c -- * * This file implements the "tcl::process" ensemble for subprocess * management as defined by TIP #462. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclProcess.c -- * * This file implements the "tcl::process" ensemble for subprocess * management as defined by TIP #462. * * Copyright © 2017 Frederic Bonnet. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclRegexp.c.
1 2 3 4 5 6 | /* * tclRegexp.c -- * * This file contains the public interfaces to the Tcl regular expression * mechanism. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | /* * tclRegexp.c -- * * This file contains the public interfaces to the Tcl regular expression * mechanism. * * Copyright © 1998 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclRegexp.h" #include <assert.h> /* *---------------------------------------------------------------------- * The routines in this file use Henry Spencer's regular expression package * contained in the following additional source files: * * regc_color.c regc_cvec.c regc_lex.c * regc_nfa.c regcomp.c regcustom.h * rege_dfa.c regerror.c regerrs.h * regex.h regexec.c regfree.c * regfronts.c regguts.h * * Copyright © 1998 Henry Spencer. All rights reserved. * * Development of this software was funded, in part, by Cray Research Inc., * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics * Corporation, none of whom are responsible for the results. The author * thanks all of them. * * Redistribution and use in source and binary forms -- with or without |
︙ | ︙ | |||
477 478 479 480 481 482 483 | /* * Save the target object so we can extract strings from it later. */ regexpPtr->string = NULL; regexpPtr->objPtr = textObj; | | | 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 | /* * Save the target object so we can extract strings from it later. */ regexpPtr->string = NULL; regexpPtr->objPtr = textObj; udata = Tcl_GetUnicodeFromObj(textObj, &length); if (offset > length) { offset = length; } udata += offset; length -= offset; |
︙ | ︙ | |||
596 597 598 599 600 601 602 | size_t length; TclRegexp *regexpPtr; const char *pattern; RegexpGetIntRep(objPtr, regexpPtr); if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) { | | | 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 | size_t length; TclRegexp *regexpPtr; const char *pattern; RegexpGetIntRep(objPtr, regexpPtr); if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) { pattern = Tcl_GetStringFromObj(objPtr, &length); regexpPtr = CompileRegexp(interp, pattern, length, flags); if (regexpPtr == NULL) { return NULL; } RegexpSetIntRep(objPtr, regexpPtr); |
︙ | ︙ |
Changes to generic/tclResolve.c.
1 2 3 4 5 6 7 8 | /* * tclResolve.c -- * * Contains hooks for customized command/variable name resolution * schemes. These hooks allow extensions like [incr Tcl] to add their own * name resolution rules to the Tcl language. Rules can be applied to a * particular namespace, to the interpreter as a whole, or both. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclResolve.c -- * * Contains hooks for customized command/variable name resolution * schemes. These hooks allow extensions like [incr Tcl] to add their own * name resolution rules to the Tcl language. Rules can be applied to a * particular namespace, to the interpreter as a whole, or both. * * Copyright © 1998 Lucent Technologies, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclResult.c.
1 2 3 4 5 | /* * tclResult.c -- * * This file contains code to manage the interpreter result. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclResult.c -- * * This file contains code to manage the interpreter result. * * Copyright © 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
358 359 360 361 362 363 364 | Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); const char *bytes; size_t length; if (Tcl_IsShared(iPtr->objResultPtr)) { Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); } | | | 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 | Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); const char *bytes; size_t length; if (Tcl_IsShared(iPtr->objResultPtr)) { Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); } bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length); if (TclNeedSpace(bytes, bytes + length)) { Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); } Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); Tcl_DecrRefCount(listPtr); } |
︙ | ︙ | |||
719 720 721 722 723 724 725 | iPtr->errorInfo = NULL; } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr); if (valuePtr != NULL) { size_t length; | | | 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 | iPtr->errorInfo = NULL; } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr); if (valuePtr != NULL) { size_t length; (void) Tcl_GetStringFromObj(valuePtr, &length); if (length) { iPtr->errorInfo = valuePtr; Tcl_IncrRefCount(iPtr->errorInfo); iPtr->flags |= ERR_ALREADY_LOGGED; } } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK], |
︙ | ︙ |
Changes to generic/tclScan.c.
1 2 3 4 5 | /* * tclScan.c -- * * This file contains the implementation of the "scan" command. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclScan.c -- * * This file contains the implementation of the "scan" command. * * Copyright © 1998 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" |
︙ | ︙ |
Changes to generic/tclStrToD.c.
1 2 3 4 5 6 7 8 9 | /* * tclStrToD.c -- * * This file contains a collection of procedures for managing conversions * to/from floating-point in Tcl. They include TclParseNumber, which * parses numbers from strings; TclDoubleDigits, which formats numbers * into strings of digits, and procedures for interconversion among * 'double' and 'mp_int' types. * | | > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | /* * tclStrToD.c -- * * This file contains a collection of procedures for managing conversions * to/from floating-point in Tcl. They include TclParseNumber, which * parses numbers from strings; TclDoubleDigits, which formats numbers * into strings of digits, and procedures for interconversion among * 'double' and 'mp_int' types. * * Copyright © 2005 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" #include <float.h> #include <math.h> #ifdef _WIN32 #define copysign _copysign #endif #ifndef PRIx64 # define PRIx64 TCL_LL_MODIFIER "x" #endif /* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be * uniquely determined by radix and by the widths of significand and exponent. */ |
︙ | ︙ | |||
533 534 535 536 537 538 539 | char d = 0; /* Last hexadecimal digit scanned; initialized * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ mp_err err = MP_OKAY; int under = 0; /* Flag trailing '_' as error if true once * number is accepted. */ | | | 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | char d = 0; /* Last hexadecimal digit scanned; initialized * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ mp_err err = MP_OKAY; int under = 0; /* Flag trailing '_' as error if true once * number is accepted. */ #define ALL_BITS UWIDE_MAX #define MOST_BITS (ALL_BITS >> 1) /* * Initialize bytes to start of the object's string rep if the caller * didn't pass anything else. */ |
︙ | ︙ | |||
716 717 718 719 720 721 722 | * too large shifts first. */ if ((octalSignificandWide != 0) && (((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt)) || (octalSignificandWide > | | | 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 | * 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) { octalSignificandWide = |
︙ | ︙ | |||
800 801 802 803 804 805 806 | * Shifting by more bits than are in the value being * shifted is at least de facto nonportable. Check for too * large shifts first. */ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || | | | 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 | * Shifting by more bits than are in the value being * shifted is at least de facto nonportable. 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) { significandWide = (significandWide << shift) + d; |
︙ | ︙ | |||
834 835 836 837 838 839 840 | case ZERO_B: zerob: if (c == '0') { numTrailZeros++; under = 0; state = BINARY; break; | | | | | > > | | 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 | 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 more bits than are in the value being * shifted is at least de facto nonportable. 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) { significandWide = (significandWide << shift) + 1; |
︙ | ︙ | |||
879 880 881 882 883 884 885 | break; case ZERO_D: if (c == '0') { under = 0; numTrailZeros++; } else if ( ! isdigit(UCHAR(c))) { | | | | | | | 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 | break; case ZERO_D: if (c == '0') { under = 0; numTrailZeros++; } else if ( ! isdigit(UCHAR(c))) { if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { /* Ignore numeric "white space" */ under = 1; break; } goto endgame; } under = 0; state = DECIMAL; flags |= TCL_PARSE_INTEGER_ONLY; /* FALLTHROUGH */ |
︙ | ︙ | |||
1526 1527 1528 1529 1530 1531 1532 | /* * There's no need to multiply if the multiplicand is zero. */ *wideRepPtr = digit; return 0; } else if (numZeros >= maxpow10_wide | | | 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 | /* * There's no need to multiply if the multiplicand is zero. */ *wideRepPtr = digit; return 0; } else if (numZeros >= maxpow10_wide || w > (UWIDE_MAX-digit)/pow10_wide[numZeros+1]) { /* * Wide multiplication will overflow. Expand the number to a * bignum and fall through into the bignum case. */ if (mp_init_u64(bignumRepPtr, w) != MP_OKAY) { return 0; |
︙ | ︙ | |||
2914 2915 2916 2917 2918 2919 2920 | if (k_check && d < 1. && ilim > 0) { if (ilim1 < 0) { return NULL; } ilim = ilim1; --k; | | | | 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 | if (k_check && d < 1. && ilim > 0) { if (ilim1 < 0) { return NULL; } ilim = ilim1; --k; d = d * 10.0; ++ieps; } /* * Compute estimated roundoff error. */ eps.d = ieps * d + 7.; eps.w.word0 -= (FP_PRECISION-1) << EXP_SHIFT; /* * Handle the peculiar case where the result has no significant digits. */ retval = (char *)Tcl_Alloc(len + 1); if (ilim == 0) { d = d - 5.; if (d > eps.d) { *retval = '1'; *decpt = k; return retval; } else if (d < -eps.d) { *decpt = k; return retval; |
︙ | ︙ | |||
5179 5180 5181 5182 5183 5184 5185 | { #ifndef IEEE_FLOATING_POINT strcpy(buffer, "NaN"); return; #else union { double dv; | | | | | | | 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 | { #ifndef IEEE_FLOATING_POINT strcpy(buffer, "NaN"); return; #else union { double dv; uint64_t iv; } bitwhack; bitwhack.dv = value; if (n770_fp) { bitwhack.iv = Nokia770Twiddle(bitwhack.iv); } if (bitwhack.iv & (UINT64_C(1) << 63)) { bitwhack.iv &= ~ (UINT64_C(1) << 63); *buffer++ = '-'; } *buffer++ = 'N'; *buffer++ = 'a'; *buffer++ = 'N'; bitwhack.iv &= ((UINT64_C(1)) << 51) - 1; if (bitwhack.iv != 0) { sprintf(buffer, "(%" PRIx64 ")", bitwhack.iv); } else { *buffer = '\0'; } #endif /* IEEE_FLOATING_POINT */ } /* |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
23 24 25 26 27 28 29 | * * To allow many appends to be done to an object without constantly * reallocating the space for the string or Unicode representation, we * allocate double the space for the string or Unicode and use the * internal representation to keep track of how much space is used vs. * allocated. * | | | | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | * * To allow many appends to be done to an object without constantly * reallocating the space for the string or Unicode representation, we * allocate double the space for the string or Unicode and use the * internal representation to keep track of how much space is used vs. * allocated. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" |
︙ | ︙ | |||
65 66 67 68 69 70 71 72 73 74 75 76 77 78 | static void GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag); static void GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); static size_t 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, size_t needed, int flag); static void GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); static size_t 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 = { |
︙ | ︙ | |||
414 415 416 417 418 419 420 | * machinery behind that test is using a proper bytearray ObjType. We * could also compute length of an improper bytearray without shimmering * but there's no value in that. We *want* to shimmer an improper bytearray * because improper bytearrays have worthless internal reps. */ if (TclIsPureByteArray(objPtr)) { | | | 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 | * machinery behind that test is using a proper bytearray ObjType. We * could also compute length of an improper bytearray without shimmering * but there's no value in that. We *want* to shimmer an improper bytearray * because improper bytearrays have worthless internal reps. */ if (TclIsPureByteArray(objPtr)) { (void) Tcl_GetByteArrayFromObj(objPtr, &numChars); return numChars; } /* * OK, need to work with the object as a string. */ |
︙ | ︙ | |||
513 514 515 516 517 518 519 | /* * Optimize the case where we're really dealing with a bytearray object * we don't need to convert to a string to perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { size_t length = 0; | | | 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | /* * Optimize the case where we're really dealing with a bytearray object * we don't need to convert to a string to perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { size_t length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; } return bytes[index]; } |
︙ | ︙ | |||
569 570 571 572 573 574 575 | #endif return ch; } /* *---------------------------------------------------------------------- * | | > > > > > > > > > > > > > > > > > > > > > > > > > | | 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 | #endif return ch; } /* *---------------------------------------------------------------------- * * Tcl_GetUnicodeFromObj/TclGetUnicodeFromObj -- * * Get the Unicode form of the String object with length. If the object * is not already a String object, it will be converted to one. If the * String object does not have a Unicode rep, then one is create from the * UTF string format. * * Results: * Returns a pointer to the object's internal Unicode string. * * Side effects: * Converts the object to have the String internal rep. * *---------------------------------------------------------------------- */ #undef Tcl_GetUnicodeFromObj Tcl_UniChar * TclGetUnicodeFromObj( Tcl_Obj *objPtr, /* The object to find the unicode string * for. */ int *lengthPtr) /* If non-NULL, the location where the string * rep's unichar length should be stored. If * NULL, no length is stored. */ { String *stringPtr; SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode == 0) { FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } if (lengthPtr != NULL) { *lengthPtr = (int)stringPtr->numChars; } return stringPtr->unicode; } Tcl_UniChar * Tcl_GetUnicodeFromObj( Tcl_Obj *objPtr, /* The object to find the unicode string * for. */ size_t *lengthPtr) /* If non-NULL, the location where the string * rep's unichar length should be stored. If * NULL, no length is stored. */ { String *stringPtr; SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); |
︙ | ︙ | |||
651 652 653 654 655 656 657 | /* * 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)) { | | | 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 | /* * 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 >= length) { last = length - 1; } if (last < first) { return Tcl_NewObj(); } |
︙ | ︙ | |||
1098 1099 1100 1101 1102 1103 1104 | toCopy = length; } else { if (ellipsis == NULL) { ellipsis = "..."; } eLen = strlen(ellipsis); while (eLen > limit) { | | | > > > > > > | 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 | toCopy = length; } else { if (ellipsis == NULL) { ellipsis = "..."; } eLen = strlen(ellipsis); while (eLen > limit) { eLen = Tcl_UtfPrev(ellipsis+eLen, ellipsis) - ellipsis; } toCopy = Tcl_UtfPrev(bytes+limit+1-eLen, bytes) - bytes; } /* * If objPtr has a valid Unicode rep, then append the Unicode conversion * of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to * objPtr's string rep. */ 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+1) > 1) { AppendUtfToUnicodeRep(objPtr, bytes, toCopy); } else { AppendUtfToUtfRep(objPtr, bytes, toCopy); } if (length <= limit) { |
︙ | ︙ | |||
1158 1159 1160 1161 1162 1163 1164 | void Tcl_AppendToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ size_t length) /* The number of bytes to append from "bytes". | | | 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 | void Tcl_AppendToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ size_t length) /* The number of bytes to append from "bytes". * If TCL_INDEX_NONE, then append all bytes up to NUL * byte. */ { Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_INDEX_NONE, NULL); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1283 1284 1285 1286 1287 1288 1289 | * cases. * * First, get the lengths. */ size_t lengthSrc = 0; | | | | > > > > > > > | | | | 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 | * cases. * * First, get the lengths. */ size_t lengthSrc = 0; (void) Tcl_GetByteArrayFromObj(objPtr, &length); (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); /* * Grow buffer enough for the append. */ TclAppendBytesToByteArray(objPtr, NULL, lengthSrc); /* * Reset objPtr back to the original value. */ Tcl_SetByteArrayLength(objPtr, length); /* * Now do the append knowing that buffer growth cannot cause any * trouble. */ TclAppendBytesToByteArray(objPtr, TclGetByteArrayFromObj(appendObjPtr, NULL), lengthSrc); return; } /* * 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 (TclHasIntRep(appendObjPtr, &tclStringType)) { Tcl_UniChar *unicode = Tcl_GetUnicodeFromObj(appendObjPtr, &numChars); AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); } else { bytes = Tcl_GetStringFromObj(appendObjPtr, &length); AppendUtfToUnicodeRep(objPtr, bytes, length); } return; } /* * Append to objPtr's UTF string rep. If we know the number of characters * in both objects before appending, then set the combined number of * characters in the final (appended-to) object. */ bytes = Tcl_GetStringFromObj(appendObjPtr, &length); numChars = stringPtr->numChars; if ((numChars != TCL_INDEX_NONE) && TclHasIntRep(appendObjPtr, &tclStringType)) { String *appendStringPtr = GET_STRING(appendObjPtr); appendNumChars = appendStringPtr->numChars; } |
︙ | ︙ | |||
1686 1687 1688 1689 1690 1691 1692 | "\"%n$\" argument index out of range" }; static const char *overflow = "max size for a Tcl value exceeded"; if (Tcl_IsShared(appendObj)) { Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } | | | 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 | "\"%n$\" argument index out of range" }; static const char *overflow = "max size for a Tcl value exceeded"; if (Tcl_IsShared(appendObj)) { Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } (void)Tcl_GetStringFromObj(appendObj, &originalLength); limit = (size_t)INT_MAX - originalLength; /* * Format string is NUL-terminated. */ while (*format != '\0') { |
︙ | ︙ | |||
2080 2081 2082 2083 2084 2085 2086 | #endif } else if (useBig) { pure = Tcl_NewBignumObj(&big); } else { TclNewIntObj(pure, l); } Tcl_IncrRefCount(pure); | | | 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 | #endif } else if (useBig) { pure = Tcl_NewBignumObj(&big); } else { TclNewIntObj(pure, l); } Tcl_IncrRefCount(pure); bytes = Tcl_GetStringFromObj(pure, &length); /* * Already did the sign above. */ if (*bytes == '-') { length--; |
︙ | ︙ | |||
2364 2365 2366 2367 2368 2369 2370 | } while (numChars < width) { Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); numChars++; } } | | | 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 | } while (numChars < width) { Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); numChars++; } } (void)Tcl_GetStringFromObj(segment, &segmentNumBytes); if (segmentNumBytes > limit) { if (allocSegment) { Tcl_DecrRefCount(segment); } msg = overflow; errCode = "OVERFLOW"; goto errorMsg; |
︙ | ︙ | |||
2508 2509 2510 2511 2512 2513 2514 | /* * Within that buffer, we trim both ends if needed so that we * copy only whole characters, and avoid copying any partial * multi-byte characters. */ | | | 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 | /* * Within that buffer, we trim both ends if needed so that we * copy only whole characters, and avoid copying any partial * multi-byte characters. */ q = Tcl_UtfPrev(end, bytes); if (!Tcl_UtfCharComplete(q, (end - q))) { end = q; } q = bytes + 4; while ((bytes < end) && (bytes < q) && ((*bytes & 0xC0) == 0x80)) { |
︙ | ︙ | |||
2716 2717 2718 2719 2720 2721 2722 | TclGetStringStorage( Tcl_Obj *objPtr, size_t *sizePtr) { String *stringPtr; if (!TclHasIntRep(objPtr, &tclStringType) || objPtr->bytes == NULL) { | | | 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 | TclGetStringStorage( Tcl_Obj *objPtr, size_t *sizePtr) { String *stringPtr; if (!TclHasIntRep(objPtr, &tclStringType) || objPtr->bytes == NULL) { return Tcl_GetStringFromObj(objPtr, sizePtr); } stringPtr = GET_STRING(objPtr); *sizePtr = stringPtr->allocated; return objPtr->bytes; } |
︙ | ︙ | |||
2773 2774 2775 2776 2777 2778 2779 | unichar = 1; } } } if (binary) { /* Result will be pure byte array. Pre-size it */ | | | | | 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 | unichar = 1; } } } if (binary) { /* Result will be pure byte array. Pre-size it */ (void)Tcl_GetByteArrayFromObj(objPtr, &length); } else if (unichar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ (void)Tcl_GetUnicodeFromObj(objPtr, &length); } else { /* Result will be concat of string reps. Pre-size it. */ (void)Tcl_GetStringFromObj(objPtr, &length); } if (length == 0) { /* Any repeats of empty is empty. */ return objPtr; } |
︙ | ︙ | |||
2808 2809 2810 2811 2812 2813 2814 | Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */ Tcl_SetByteArrayLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } TclAppendBytesToByteArray(objResultPtr, | | | 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 | Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */ Tcl_SetByteArrayLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } TclAppendBytesToByteArray(objResultPtr, TclGetByteArrayFromObj(objResultPtr, NULL), (count - done) * length); } else if (unichar) { /* * Efficiently produce a pure Tcl_UniChar array result. */ if (!inPlace || Tcl_IsShared(objPtr)) { |
︙ | ︙ | |||
2897 2898 2899 2900 2901 2902 2903 | int objc, Tcl_Obj * const objv[], int flags) { Tcl_Obj *objResultPtr, * const *ov; int oc, binary = 1; size_t length = 0; | | | 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 | int objc, Tcl_Obj * const objv[], int flags) { Tcl_Obj *objResultPtr, * const *ov; int oc, binary = 1; size_t length = 0; 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) { |
︙ | ︙ | |||
2933 2934 2935 2936 2937 2938 2939 | if (objPtr->length) { /* * Non-empty string rep. Not a pure bytearray, so we won't * create a pure bytearray. */ binary = 0; | > > | | 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 | 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; |
︙ | ︙ | |||
2969 2970 2971 2972 2973 2974 2975 | /* * Every argument is either a bytearray with a ("pure") * value we know we can safely use, or it is an empty string. * We don't need to count bytes for the empty strings. */ if (TclIsPureByteArray(objPtr)) { | | | | | 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 | /* * Every argument is either a bytearray with a ("pure") * value we know we can safely use, or it is an empty string. * We don't need to count bytes for the empty strings. */ if (TclIsPureByteArray(objPtr)) { (void)Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ if (numBytes) { last = objc - oc; if (length == 0) { first = last; } length += numBytes; } } } while (--oc); } else if ((allowUniChar && requestUniChar) || forceUniChar) { /* * Result will be pure Tcl_UniChar array. Pre-size it. */ ov = objv; oc = objc; do { Tcl_Obj *objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { size_t numChars; (void)Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ if (numChars) { last = objc - oc; if (length == 0) { first = last; } length += numChars; } |
︙ | ︙ | |||
3024 3025 3026 3027 3028 3029 3030 | Tcl_Obj *objPtr = *ov++; if (objPtr->bytes == NULL) { /* No string rep; Take the chance we can avoid making it */ pendingPtr = objPtr; } else { | | | 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 | Tcl_Obj *objPtr = *ov++; if (objPtr->bytes == NULL) { /* No string rep; Take the chance we can avoid making it */ pendingPtr = objPtr; } else { (void)Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */ } } while (--oc && (length == 0) && (pendingPtr == NULL)); /* * Either we found a possibly non-empty value, and we remember * this index as the first and last such value so far seen, * or (oc == 0) and all values are known empty, |
︙ | ︙ | |||
3050 3051 3052 3053 3054 3055 3056 | * There's a pending value followed by more values. Loop over * remaining values generating strings until a non-empty value * is found, or the pending value gets its string generated. */ do { Tcl_Obj *objPtr = *ov++; | | | | 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 | * There's a pending value followed by more values. Loop over * remaining values generating strings until a non-empty value * is found, or the pending value gets its string generated. */ do { Tcl_Obj *objPtr = *ov++; (void)Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ } while (--oc && numBytes == 0 && pendingPtr->bytes == NULL); if (numBytes) { last = objc -oc -1; } if (oc || numBytes) { (void)Tcl_GetStringFromObj(pendingPtr, &length); } if (length == 0) { if (numBytes) { first = last; } } else if (numBytes + length > (size_t)INT_MAX) { goto overflow; |
︙ | ︙ | |||
3110 3111 3112 3113 3114 3115 3116 | * failure to allocate enough space. Following stanza may panic. */ if (inPlace && !Tcl_IsShared(*objv)) { size_t start = 0; objResultPtr = *objv++; objc--; | | | | | | 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 | * failure to allocate enough space. Following stanza may panic. */ if (inPlace && !Tcl_IsShared(*objv)) { size_t start = 0; objResultPtr = *objv++; objc--; (void)Tcl_GetByteArrayFromObj(objResultPtr, &start); dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; } else { objResultPtr = Tcl_NewByteArrayObj(NULL, length); dst = Tcl_SetByteArrayLength(objResultPtr, length); } while (objc--) { Tcl_Obj *objPtr = *objv++; /* * Every argument is either a bytearray with a ("pure") * value we know we can safely use, or it is an empty string. * We don't need to copy bytes from the empty strings. */ if (TclIsPureByteArray(objPtr)) { size_t more = 0; 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)) { size_t start; objResultPtr = *objv++; objc--; /* Ugly interface! Force resize of the unicode array. */ (void)Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", STRING_SIZE(length))); |
︙ | ︙ | |||
3178 3179 3180 3181 3182 3183 3184 | dst = Tcl_GetUnicode(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { size_t more; | | | | 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 | dst = Tcl_GetUnicode(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { size_t more; Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more); memcpy(dst, src, more * sizeof(Tcl_UniChar)); dst += more; } } } else { /* Efficiently concatenate string reps */ char *dst; if (inPlace && !Tcl_IsShared(*objv)) { size_t start; objResultPtr = *objv++; objc--; (void)Tcl_GetStringFromObj(objResultPtr, &start); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } |
︙ | ︙ | |||
3225 3226 3227 3228 3229 3230 3231 | dst = TclGetString(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { size_t more; | | | 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 | dst = TclGetString(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { size_t more; char *src = Tcl_GetStringFromObj(objPtr, &more); memcpy(dst, src, more); dst += more; } } /* Must NUL-terminate! */ *dst = '\0'; |
︙ | ︙ | |||
3289 3290 3291 3292 3293 3294 3295 | /* * Use binary versions of comparisons since that won't cause undue * type conversions and it is much faster. Only do this if we're * case-sensitive (which is all that really makes sense with byte * arrays anyway, and we have no memcasecmp() for some reason... :^) */ | | | | | | | | | | | 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 | /* * Use binary versions of comparisons since that won't cause undue * type conversions and it is much faster. Only do this if we're * 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 (TclHasIntRep(value1Ptr, &tclStringType) && TclHasIntRep(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. */ if (nocase) { s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); memCmpFn = (memCmpFn_t)TclUniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); s2len = Tcl_GetCharLength(value2Ptr); if ((s1len == value1Ptr->length) && (value1Ptr->bytes != NULL) && (s2len == value2Ptr->length) && (value2Ptr->bytes != NULL)) { s1 = value1Ptr->bytes; s2 = value2Ptr->bytes; memCmpFn = memcmp; } else { s1 = (char *) Tcl_GetUnicode(value1Ptr); s2 = (char *) Tcl_GetUnicode(value2Ptr); if ( #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3) 1 #else checkEq #endif ) { memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); } else { memCmpFn = (memCmpFn_t) TclUniCharNcmp; } } } } else { empty = TclCheckEmptyString(value1Ptr); if (empty > 0) { switch (TclCheckEmptyString(value2Ptr)) { case -1: s1 = 0; s1len = 0; s2 = Tcl_GetStringFromObj(value2Ptr, &s2len); break; case 0: match = -1; goto matchdone; case 1: default: /* avoid warn: `s2` may be used uninitialized */ match = 0; goto matchdone; } } else if (TclCheckEmptyString(value2Ptr) > 0) { switch (empty) { case -1: s2 = 0; s2len = 0; s1 = Tcl_GetStringFromObj(value1Ptr, &s1len); break; case 0: match = 1; goto matchdone; case 1: default: /* avoid warn: `s1` may be used uninitialized */ match = 0; goto matchdone; } } else { s1 = Tcl_GetStringFromObj(value1Ptr, &s1len); s2 = Tcl_GetStringFromObj(value2Ptr, &s2len); } if (!nocase && checkEq) { /* * When we have equal-length we can check only for * (in)equality. We can use memcmp in all (n)eq cases because * we don't need to worry about lexical LE/BE variance. */ |
︙ | ︙ | |||
3469 3470 3471 3472 3473 3474 3475 | * Whenever this routine is turned into a proper substring * finder, change to `return start` after limits imposed. */ goto firstEnd; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { unsigned char *end, *check, *bh; | | | | 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 | * Whenever this routine is turned into a proper substring * finder, change to `return start` after limits imposed. */ goto firstEnd; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { unsigned char *end, *check, *bh; unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); /* Find bytes in bytes */ bh = Tcl_GetByteArrayFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ goto firstEnd; } end = bh + lh; check = bh + start; |
︙ | ︙ | |||
3515 3516 3517 3518 3519 3520 3521 | * code pathway, or if it does we want that to be for some values * we explicitly decline to support. Getting there will involve * locking down in practice more firmly just what encodings produce * what supported results for the objPtr->bytes values. For now, * do only the well-defined Tcl_UniChar array search. */ | | | | 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 | * code pathway, or if it does we want that to be for some values * we explicitly decline to support. Getting there will involve * locking down in practice more firmly just what encodings produce * what supported results for the objPtr->bytes values. For now, * do only the well-defined Tcl_UniChar array search. */ un = Tcl_GetUnicodeFromObj(needle, &ln); uh = Tcl_GetUnicodeFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ goto firstEnd; } endStr = uh + lh; for (checkStr = uh + start; checkStr + ln <= endStr; checkStr++) { |
︙ | ︙ | |||
3575 3576 3577 3578 3579 3580 3581 | * TODO: When we one day make this a true substring * finder, change this to "return last", after limitation. */ goto lastEnd; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { | | | | 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 | * TODO: When we one day make this a true substring * finder, change this to "return last", after limitation. */ goto lastEnd; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { unsigned char *check, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); if (last + 1 >= lh + 1) { last = lh - 1; } if (last + 1 < ln) { /* Don't start the loop if there cannot be a valid answer */ goto lastEnd; |
︙ | ︙ | |||
3598 3599 3600 3601 3602 3603 3604 | goto lastEnd; } check--; } goto lastEnd; } | | | | 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 | goto lastEnd; } check--; } goto lastEnd; } uh = Tcl_GetUnicodeFromObj(haystack, &lh); un = Tcl_GetUnicodeFromObj(needle, &ln); if (last + 1 >= lh + 1) { last = lh - 1; } if (last + 1 < ln) { /* Don't start the loop if there cannot be a valid answer */ goto lastEnd; |
︙ | ︙ | |||
3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 | TclStringReverse( Tcl_Obj *objPtr, int flags) { String *stringPtr; Tcl_UniChar ch = 0; int inPlace = flags & TCL_STRING_IN_PLACE; if (TclIsPureByteArray(objPtr)) { size_t numBytes = 0; | > > > | | > < < | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 | TclStringReverse( Tcl_Obj *objPtr, int flags) { String *stringPtr; Tcl_UniChar ch = 0; int inPlace = flags & TCL_STRING_IN_PLACE; #if TCL_UTF_MAX < 4 int needFlip = 0; #endif if (TclIsPureByteArray(objPtr)) { size_t numBytes = 0; unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); } ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL), from, numBytes); return objPtr; } 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; #else *to++ = *src; #endif } } else { /* * Reversing in place. */ #if TCL_UTF_MAX < 4 to = src; #endif while (--src > from) { ch = *src; #if TCL_UTF_MAX < 4 if ((ch & 0xF800) == 0xD800) { needFlip = 1; } #endif *src = *from; *from++ = ch; } } #if TCL_UTF_MAX < 4 if (needFlip) { /* * Flip back surrogate pairs. */ from = to - stringPtr->numChars; while (--to >= from) { ch = *to; if ((ch & 0xFC00) == 0xD800) { if ((to-1 >= from) && ((to[-1] & 0xFC00) == 0xDC00)) { to[0] = to[-1]; to[-1] = ch; --to; } } } } #endif } if (objPtr->bytes) { size_t numChars = stringPtr->numChars; size_t numBytes = objPtr->length; char *to, *from = objPtr->bytes; |
︙ | ︙ | |||
3739 3740 3741 3742 3743 3744 3745 | * represented by objPtr->bytes and we need Pass 1 just in case, * or numChars >= 0 and we know we have fewer chars than bytes, so * we know there's a multibyte character needing Pass 1. * * Pass 1. Reverse the bytes of each multi-byte character. */ | < > | < < | 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 | * represented by objPtr->bytes and we need Pass 1 just in case, * or numChars >= 0 and we know we have fewer chars than bytes, so * we know there's a multibyte character needing Pass 1. * * Pass 1. Reverse the bytes of each multi-byte character. */ size_t bytesLeft = numBytes; int chw; while (bytesLeft) { /* * NOTE: We know that the from buffer is NUL-terminated. It's * part of the contract for objPtr->bytes values. Thus, we can * skip calling Tcl_UtfCharComplete() here. */ size_t bytesInChar = TclUtfToUCS4(from, &chw); ReverseBytes((unsigned char *)to, (unsigned char *)from, bytesInChar); to += bytesInChar; from += bytesInChar; bytesLeft -= bytesInChar; } from = to = objPtr->bytes; } /* Pass 2. Reverse all the bytes. */ ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes); } return objPtr; } |
︙ | ︙ | |||
3825 3826 3827 3828 3829 3830 3831 | * to be able to process index values. This means it is likely that * objPtr is either a proper "bytearray" or a "string" or else it has * a known and short string rep. */ if (TclIsPureByteArray(objPtr)) { size_t numBytes = 0; | | | 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 | * to be able to process index values. This means it is likely that * objPtr is either a proper "bytearray" or a "string" or else it has * a known and short string rep. */ if (TclIsPureByteArray(objPtr)) { size_t numBytes = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (insertPtr == NULL) { /* Replace something with nothing. */ assert ( first <= numBytes ) ; assert ( count <= numBytes ) ; assert ( first + count <= numBytes ) ; |
︙ | ︙ | |||
3849 3850 3851 3852 3853 3854 3855 | if ((first == 0) && (count == numBytes)) { return insertPtr; } if (TclIsPureByteArray(insertPtr)) { size_t newBytes = 0; unsigned char *iBytes | | | 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 | if ((first == 0) && (count == numBytes)) { return insertPtr; } if (TclIsPureByteArray(insertPtr)) { size_t newBytes = 0; unsigned char *iBytes = Tcl_GetByteArrayFromObj(insertPtr, &newBytes); if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) { /* * Removal count and replacement count are equal. * Other conditions permit. Do in-place splice. */ |
︙ | ︙ | |||
3893 3894 3895 3896 3897 3898 3899 | * when it can be determined objPtr->bytes points to a string of * all single-byte characters so we can index it directly. */ /* The traditional implementation... */ { size_t numChars; | | | 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 | * when it can be determined objPtr->bytes points to a string of * all single-byte characters so we can index it directly. */ /* The traditional implementation... */ { size_t numChars; Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars); /* TODO: Is there an in-place option worth pursuing here? */ result = Tcl_NewUnicodeObj(ustring, first); if (insertPtr) { Tcl_AppendObjToObj(result, insertPtr); } |
︙ | ︙ | |||
3968 3969 3970 3971 3972 3973 3974 | stringPtr->hasUnicode = 1; if (bytes) { stringPtr->numChars = needed; } else { numAppendChars = 0; } | | > > > > > > > > > | > > > > | 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 | 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; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Added generic/tclStubCall.c.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 | /* * tclStubCall.c -- * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifndef _WIN32 # include <dlfcn.h> #else # define dlopen(a,b) (void *)LoadLibraryW(JOIN(L,a)) # define dlsym(a,b) (void *)GetProcAddress((HMODULE)(a),b) # define dlerror() "" #endif MODULE_SCOPE void *tclStubsHandle; /* *---------------------------------------------------------------------- * * TclStubCall -- * * Load the Tcl core dynamically, version "9.0" (or higher, in future versions). * * Results: * Returns a function from the Tcl dynamic library or a function * returning NULL if that function cannot be found. See PROCNAME table. * * The functions Tcl_MainEx and Tcl_MainExW never return. * Tcl_GetMemoryInfo and Tcl_StaticLibrary return (void), * Tcl_SetExitProc returns its previous exitProc and * Tcl_SetPreInitScript returns the previous script. This means that * those 6 functions cannot be used to initialize the stub-table, * only the first 4 functions in the table can do that. * *---------------------------------------------------------------------- */ /* Table containing which function will be returned, depending on the "arg" */ static const char PROCNAME[][24] = { "_Tcl_SetPanicProc", /* Default, whenever "arg" <= 0 or "arg" > 8 */ "_Tcl_InitSubsystems", /* "arg" == (void *)1 */ "_Tcl_FindExecutable", /* "arg" == (void *)2 */ "_TclZipfs_AppHook", /* "arg" == (void *)3 */ "_Tcl_MainExW", /* "arg" == (void *)4 */ "_Tcl_MainEx", /* "arg" == (void *)5 */ "_Tcl_StaticLibrary", /* "arg" == (void *)6 */ "_Tcl_SetExitProc", /* "arg" == (void *)7 */ "_Tcl_GetMemoryInfo", /* "arg" == (void *)8 */ "_Tcl_SetPreInitScript" /* "arg" == (void *)9 */ }; MODULE_SCOPE const void *nullVersionProc(void) { return NULL; } static const char CANNOTCALL[] = "Cannot call %s from stubbed extension\n"; static const char CANNOTFIND[] = "Cannot find %s: %s\n"; MODULE_SCOPE void * TclStubCall(void *arg) { static void *stubFn[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}; size_t index = PTR2UINT(arg); if (index >= sizeof(PROCNAME)/sizeof(PROCNAME[0])) { /* Any other value means Tcl_SetPanicProc() with non-null panicProc */ index = 0; } if (tclStubsHandle == INT2PTR(-1)) { if ((index == 0) && (arg != NULL)) { ((Tcl_PanicProc *)arg)(CANNOTCALL, PROCNAME[index] + 1); } else { fprintf(stderr, CANNOTCALL, PROCNAME[index] + 1); abort(); } } if (!stubFn[index]) { if (!tclStubsHandle) { tclStubsHandle = dlopen(CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL); if (!tclStubsHandle) { #if defined(_WIN32) tclStubsHandle = dlopen(CFG_RUNTIME_BINDIR "\\" CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL); #elif defined(__CYGWIN__) tclStubsHandle = dlopen(CFG_RUNTIME_BINDIR "/" CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL); #else tclStubsHandle = dlopen(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL); #endif } if (!tclStubsHandle) { if ((index == 0) && (arg != NULL)) { ((Tcl_PanicProc *)arg)(CANNOTFIND, CFG_RUNTIME_DLLFILE, dlerror()); } else { fprintf(stderr, CANNOTFIND, CFG_RUNTIME_DLLFILE, dlerror()); abort(); } } } stubFn[index] = dlsym(tclStubsHandle, PROCNAME[index] + 1); if (!stubFn[index]) { stubFn[index] = dlsym(tclStubsHandle, PROCNAME[index]); if (!stubFn[index]) { stubFn[index] = (void *)nullVersionProc; } } } return stubFn[index]; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclStubInit.c.
1 2 3 4 5 | /* * tclStubInit.c -- * * This file contains the initializers for the Tcl stub vectors. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclStubInit.c -- * * This file contains the initializers for the Tcl stub vectors. * * Copyright © 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath_private.h" |
︙ | ︙ | |||
56 57 58 59 60 61 62 | #undef Tcl_SetIntObj #undef Tcl_SetLongObj #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt #undef TclWinSetSockOpt #undef TclWinNToHS | | | > > > > > > | > > > > > | 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 | #undef Tcl_SetIntObj #undef Tcl_SetLongObj #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt #undef TclWinSetSockOpt #undef TclWinNToHS #undef TclStaticLibrary #undef Tcl_BackgroundError #define TclStaticLibrary Tcl_StaticLibrary #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar #define TclUnusedStubEntry 0 #if !defined(_WIN32) && !defined(__CYGWIN__) #undef Tcl_WinConvertError #define Tcl_WinConvertError 0 #endif #if TCL_UTF_MAX <= 3 static void uniCodePanic() { 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 (Tcl_UniChar *(*)(Tcl_Obj *, size_t *))(void *)uniCodePanic # define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, size_t))(void *)uniCodePanic # define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic #endif #define TclUtfCharComplete Tcl_UtfCharComplete #define TclUtfNext Tcl_UtfNext #define TclUtfPrev Tcl_UtfPrev #define TclBN_mp_add mp_add #define TclBN_mp_add_d mp_add_d #define TclBN_mp_and mp_and #define TclBN_mp_clamp mp_clamp #define TclBN_mp_clear mp_clear #define TclBN_mp_clear_multi mp_clear_multi |
︙ | ︙ | |||
110 111 112 113 114 115 116 | #define TclBN_mp_mul mp_mul #define TclBN_mp_mul_d mp_mul_d #define TclBN_mp_mul_2 mp_mul_2 #define TclBN_mp_mul_2d mp_mul_2d #define TclBN_mp_neg mp_neg #define TclBN_mp_or mp_or #define TclBN_mp_radix_size mp_radix_size | < > | > > > | > | | < < > | > > > > > > > > > | 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 | #define TclBN_mp_mul mp_mul #define TclBN_mp_mul_d mp_mul_d #define TclBN_mp_mul_2 mp_mul_2 #define TclBN_mp_mul_2d mp_mul_2d #define TclBN_mp_neg mp_neg #define TclBN_mp_or mp_or #define TclBN_mp_radix_size mp_radix_size #define TclBN_mp_read_radix mp_read_radix #define TclBN_mp_rshd mp_rshd #define TclBN_mp_set_i64 mp_set_i64 #define TclBN_mp_set_u64 mp_set_u64 #define TclBN_mp_shrink mp_shrink #define TclBN_mp_sqr mp_sqr #define TclBN_mp_sqrt mp_sqrt #define TclBN_mp_sub mp_sub #define TclBN_mp_sub_d mp_sub_d #define TclBN_mp_signed_rsh mp_signed_rsh #define TclBN_mp_to_radix mp_to_radix #define TclBN_mp_to_ubin mp_to_ubin #define TclBN_mp_ubin_size mp_ubin_size #define TclBN_mp_unpack mp_unpack #define TclBN_mp_xor mp_xor #define TclBN_mp_zero mp_zero #define TclBN_s_mp_add s_mp_add #define TclBN_mp_balance_mul s_mp_balance_mul #define TclBN_mp_karatsuba_mul s_mp_karatsuba_mul #define TclBN_mp_karatsuba_sqr s_mp_karatsuba_sqr #define TclBN_s_mp_mul_digs s_mp_mul_digs #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 TclpCreateTempFile_ TclpCreateTempFile #define TclGetAndDetachPids_ TclGetAndDetachPids #define TclpCreateCommandChannel_ TclpCreateCommandChannel #define TclpCloseFile_ TclpCloseFile #define TclpMakeFile_ TclpMakeFile #define TclpOpenFile_ TclpOpenFile #ifndef MAC_OSX_TCL /* On UNIX, fill with other stub entries */ # define Tcl_MacOSXOpenVersionedBundleResources 0 # define Tcl_MacOSXNotifierAddRunLoopMode 0 #endif #define TclMacOSXNotifierAddRunLoopMode Tcl_MacOSXNotifierAddRunLoopMode #ifdef _WIN32 # define Tcl_CreateFileHandler 0 # define Tcl_DeleteFileHandler 0 # define Tcl_GetOpenFile 0 # define TclpCreatePipe_ TclpCreatePipe #else # define TclpIsAtty isatty # define TclpCreatePipe_ (int (*)(TclFile *, TclFile *))(void *)TclUnixCopyFile #endif #ifdef _WIN32 # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 # define TclpReaddir 0 # undef TclpIsAtty # define TclpIsAtty 0 #elif defined(__CYGWIN__) # define TclpIsAtty isatty static void doNothing(void) { /* dummy implementation, no need to do anything */ |
︙ | ︙ | |||
242 243 244 245 246 247 248 | static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); } #define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp #endif /* TCL_WIDE_INT_IS_LONG */ | | > > > > > > | 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 | static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); } #define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp #endif /* TCL_WIDE_INT_IS_LONG */ #else /* __CYGWIN__ */ # define TclWinGetTclInstance (void *(*)(void))(void *)TclpCreateProcess # define TclpGetPid (size_t(*)(Tcl_Pid))(void *)TclUnixWaitForFile # define TclWinFlushDirtyChannels 0 # define TclWinNoBackslash 0 # define TclWinAddProcess 0 #endif /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations * below should be made in the generic/tcl.decls script. */ |
︙ | ︙ | |||
304 305 306 307 308 309 310 | 0, /* 30 */ TclGetExtension, /* 31 */ TclGetFrame, /* 32 */ 0, /* 33 */ 0, /* 34 */ 0, /* 35 */ 0, /* 36 */ | | | | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 | 0, /* 30 */ TclGetExtension, /* 31 */ TclGetFrame, /* 32 */ 0, /* 33 */ 0, /* 34 */ 0, /* 35 */ 0, /* 36 */ 0, /* 37 */ TclGetNamespaceForQualName, /* 38 */ TclGetObjInterpProc, /* 39 */ TclGetOpenMode, /* 40 */ TclGetOriginalCommand, /* 41 */ TclpGetUserHome, /* 42 */ 0, /* 43 */ 0, /* 44 */ TclHideUnsafeCommands, /* 45 */ TclInExit, /* 46 */ 0, /* 47 */ 0, /* 48 */ 0, /* 49 */ 0, /* 50 */ TclInterpInit, /* 51 */ |
︙ | ︙ | |||
368 369 370 371 372 373 374 | 0, /* 94 */ 0, /* 95 */ TclRenameCommand, /* 96 */ TclResetShadowedCmdRefs, /* 97 */ TclServiceIdle, /* 98 */ 0, /* 99 */ 0, /* 100 */ | | | 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 | 0, /* 94 */ 0, /* 95 */ TclRenameCommand, /* 96 */ TclResetShadowedCmdRefs, /* 97 */ TclServiceIdle, /* 98 */ 0, /* 99 */ 0, /* 100 */ 0, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ 0, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ TclTeardownNamespace, /* 108 */ |
︙ | ︙ | |||
503 504 505 506 507 508 509 | TclPtrMakeUpvar, /* 229 */ TclObjLookupVar, /* 230 */ TclGetNamespaceFromObj, /* 231 */ TclEvalObjEx, /* 232 */ TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < > | | 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 | TclPtrMakeUpvar, /* 229 */ TclObjLookupVar, /* 230 */ TclGetNamespaceFromObj, /* 231 */ TclEvalObjEx, /* 232 */ TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ TclAppendUnicodeToObj, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ TclNRRunCallbacks, /* 240 */ TclNREvalObjEx, /* 241 */ TclNREvalObjv, /* 242 */ TclDbDumpActiveObjects, /* 243 */ TclGetNamespaceChildTable, /* 244 */ TclGetNamespaceCommandTable, /* 245 */ TclInitRewriteEnsemble, /* 246 */ TclResetRewriteEnsemble, /* 247 */ TclCopyChannel, /* 248 */ TclDoubleDigits, /* 249 */ TclSetChildCancelFlags, /* 250 */ TclRegisterLiteral, /* 251 */ TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticLibrary, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ TclGetBytesFromObj, /* 259 */ }; static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ 0, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ TclpMakeFile, /* 6 */ TclpOpenFile, /* 7 */ TclpGetPid, /* 8 */ TclpCreateTempFile, /* 9 */ 0, /* 10 */ TclGetAndDetachPids, /* 11 */ 0, /* 12 */ 0, /* 13 */ TclpCreatePipe_, /* 14 */ TclpCreateProcess, /* 15 */ TclpIsAtty, /* 16 */ TclUnixCopyFile, /* 17 */ 0, /* 18 */ TclMacOSXNotifierAddRunLoopMode, /* 19 */ TclWinAddProcess, /* 20 */ 0, /* 21 */ TclpCreateTempFile_, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ 0, /* 25 */ 0, /* 26 */ TclWinFlushDirtyChannels, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ 0, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ TclpMakeFile, /* 6 */ TclpOpenFile, /* 7 */ TclpGetPid, /* 8 */ TclpCreateTempFile, /* 9 */ 0, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile_, /* 12 */ TclpCreateCommandChannel_, /* 13 */ TclpCreatePipe_, /* 14 */ TclpCreateProcess, /* 15 */ TclpIsAtty, /* 16 */ TclUnixCopyFile, /* 17 */ TclpMakeFile_, /* 18 */ TclpOpenFile_, /* 19 */ TclWinAddProcess, /* 20 */ 0, /* 21 */ TclpCreateTempFile_, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ 0, /* 25 */ 0, /* 26 */ TclWinFlushDirtyChannels, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ 0, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ TclpMakeFile, /* 6 */ TclpOpenFile, /* 7 */ TclpGetPid, /* 8 */ TclpCreateTempFile, /* 9 */ 0, /* 10 */ TclGetAndDetachPids, /* 11 */ 0, /* 12 */ 0, /* 13 */ TclpCreatePipe_, /* 14 */ TclpCreateProcess, /* 15 */ TclpIsAtty, /* 16 */ TclUnixCopyFile, /* 17 */ 0, /* 18 */ TclMacOSXNotifierAddRunLoopMode, /* 19 */ TclWinAddProcess, /* 20 */ 0, /* 21 */ TclpCreateTempFile_, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ 0, /* 25 */ 0, /* 26 */ TclWinFlushDirtyChannels, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* MACOSX */ }; static const TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, 0, 0, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ Tcl_MacOSXNotifierAddRunLoopMode, /* 2 */ Tcl_WinConvertError, /* 3 */ }; const TclTomMathStubs tclTomMathStubs = { TCL_STUB_MAGIC, 0, TclBN_epoch, /* 0 */ TclBN_revision, /* 1 */ |
︙ | ︙ | |||
717 718 719 720 721 722 723 | 0, /* 64 */ TclBN_mp_init_i64, /* 65 */ TclBN_mp_init_u64, /* 66 */ 0, /* 67 */ TclBN_mp_set_u64, /* 68 */ TclBN_mp_get_mag_u64, /* 69 */ TclBN_mp_set_i64, /* 70 */ | | | 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 | 0, /* 64 */ TclBN_mp_init_i64, /* 65 */ TclBN_mp_init_u64, /* 66 */ 0, /* 67 */ TclBN_mp_set_u64, /* 68 */ TclBN_mp_get_mag_u64, /* 69 */ TclBN_mp_set_i64, /* 70 */ TclBN_mp_unpack, /* 71 */ 0, /* 72 */ 0, /* 73 */ 0, /* 74 */ 0, /* 75 */ TclBN_mp_signed_rsh, /* 76 */ 0, /* 77 */ TclBN_mp_to_ubin, /* 78 */ |
︙ | ︙ | |||
747 748 749 750 751 752 753 | Tcl_Panic, /* 2 */ Tcl_Alloc, /* 3 */ Tcl_Free, /* 4 */ Tcl_Realloc, /* 5 */ Tcl_DbCkalloc, /* 6 */ Tcl_DbCkfree, /* 7 */ Tcl_DbCkrealloc, /* 8 */ | < < < < < < < < < < < < < < < < | 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 | Tcl_Panic, /* 2 */ Tcl_Alloc, /* 3 */ Tcl_Free, /* 4 */ Tcl_Realloc, /* 5 */ Tcl_DbCkalloc, /* 6 */ Tcl_DbCkfree, /* 7 */ Tcl_DbCkrealloc, /* 8 */ Tcl_CreateFileHandler, /* 9 */ Tcl_DeleteFileHandler, /* 10 */ Tcl_SetTimer, /* 11 */ Tcl_Sleep, /* 12 */ Tcl_WaitForEvent, /* 13 */ Tcl_AppendAllObjTypes, /* 14 */ Tcl_AppendStringsToObj, /* 15 */ Tcl_AppendToObj, /* 16 */ Tcl_ConcatObj, /* 17 */ |
︙ | ︙ | |||
787 788 789 790 791 792 793 | 0, /* 26 */ Tcl_DbNewObj, /* 27 */ Tcl_DbNewStringObj, /* 28 */ Tcl_DuplicateObj, /* 29 */ TclFreeObj, /* 30 */ Tcl_GetBoolean, /* 31 */ Tcl_GetBooleanFromObj, /* 32 */ | | | | 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 | 0, /* 26 */ Tcl_DbNewObj, /* 27 */ Tcl_DbNewStringObj, /* 28 */ Tcl_DuplicateObj, /* 29 */ TclFreeObj, /* 30 */ Tcl_GetBoolean, /* 31 */ Tcl_GetBooleanFromObj, /* 32 */ TclGetByteArrayFromObj, /* 33 */ Tcl_GetDouble, /* 34 */ Tcl_GetDoubleFromObj, /* 35 */ 0, /* 36 */ Tcl_GetInt, /* 37 */ Tcl_GetIntFromObj, /* 38 */ Tcl_GetLongFromObj, /* 39 */ Tcl_GetObjType, /* 40 */ TclGetStringFromObj, /* 41 */ Tcl_InvalidateStringRep, /* 42 */ Tcl_ListObjAppendList, /* 43 */ Tcl_ListObjAppendElement, /* 44 */ Tcl_ListObjGetElements, /* 45 */ Tcl_ListObjIndex, /* 46 */ Tcl_ListObjLength, /* 47 */ Tcl_ListObjReplace, /* 48 */ |
︙ | ︙ | |||
921 922 923 924 925 926 927 | Tcl_GetCommandName, /* 160 */ Tcl_GetErrno, /* 161 */ Tcl_GetHostName, /* 162 */ Tcl_GetInterpPath, /* 163 */ Tcl_GetParent, /* 164 */ Tcl_GetNameOfExecutable, /* 165 */ Tcl_GetObjResult, /* 166 */ | < < < < < < < < | 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 | Tcl_GetCommandName, /* 160 */ Tcl_GetErrno, /* 161 */ Tcl_GetHostName, /* 162 */ Tcl_GetInterpPath, /* 163 */ Tcl_GetParent, /* 164 */ Tcl_GetNameOfExecutable, /* 165 */ Tcl_GetObjResult, /* 166 */ Tcl_GetOpenFile, /* 167 */ Tcl_GetPathType, /* 168 */ Tcl_Gets, /* 169 */ Tcl_GetsObj, /* 170 */ Tcl_GetServiceMode, /* 171 */ Tcl_GetChild, /* 172 */ Tcl_GetStdChannel, /* 173 */ 0, /* 174 */ |
︙ | ︙ | |||
1088 1089 1090 1091 1092 1093 1094 | Tcl_ThreadQueueEvent, /* 319 */ Tcl_UniCharAtIndex, /* 320 */ Tcl_UniCharToLower, /* 321 */ Tcl_UniCharToTitle, /* 322 */ Tcl_UniCharToUpper, /* 323 */ Tcl_UniCharToUtf, /* 324 */ Tcl_UtfAtIndex, /* 325 */ | | | | | 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 | Tcl_ThreadQueueEvent, /* 319 */ Tcl_UniCharAtIndex, /* 320 */ Tcl_UniCharToLower, /* 321 */ Tcl_UniCharToTitle, /* 322 */ Tcl_UniCharToUpper, /* 323 */ Tcl_UniCharToUtf, /* 324 */ Tcl_UtfAtIndex, /* 325 */ TclUtfCharComplete, /* 326 */ Tcl_UtfBackslash, /* 327 */ Tcl_UtfFindFirst, /* 328 */ Tcl_UtfFindLast, /* 329 */ TclUtfNext, /* 330 */ TclUtfPrev, /* 331 */ Tcl_UtfToExternal, /* 332 */ Tcl_UtfToExternalDString, /* 333 */ Tcl_UtfToLower, /* 334 */ Tcl_UtfToTitle, /* 335 */ Tcl_UtfToChar16, /* 336 */ Tcl_UtfToUpper, /* 337 */ Tcl_WriteChars, /* 338 */ |
︙ | ︙ | |||
1196 1197 1198 1199 1200 1201 1202 | Tcl_UntraceCommand, /* 427 */ Tcl_AttemptAlloc, /* 428 */ Tcl_AttemptDbCkalloc, /* 429 */ Tcl_AttemptRealloc, /* 430 */ Tcl_AttemptDbCkrealloc, /* 431 */ Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ | | | 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 | Tcl_UntraceCommand, /* 427 */ Tcl_AttemptAlloc, /* 428 */ Tcl_AttemptDbCkalloc, /* 429 */ Tcl_AttemptRealloc, /* 430 */ Tcl_AttemptDbCkrealloc, /* 431 */ Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ TclGetUnicodeFromObj, /* 434 */ 0, /* 435 */ 0, /* 436 */ Tcl_SubstObj, /* 437 */ Tcl_DetachChannel, /* 438 */ Tcl_IsStandardChannel, /* 439 */ Tcl_FSCopyFile, /* 440 */ Tcl_FSCopyDirectory, /* 441 */ |
︙ | ︙ | |||
1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 | Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ Tcl_LinkArray, /* 644 */ Tcl_GetIntForIndex, /* 645 */ Tcl_UtfToUniChar, /* 646 */ Tcl_UniCharToUtfDString, /* 647 */ Tcl_UtfToUniCharDString, /* 648 */ }; /* !END!: Do not edit above this line. */ | > > > > > > > > | 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 | Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ Tcl_LinkArray, /* 644 */ Tcl_GetIntForIndex, /* 645 */ Tcl_UtfToUniChar, /* 646 */ Tcl_UniCharToUtfDString, /* 647 */ Tcl_UtfToUniCharDString, /* 648 */ 0, /* 649 */ 0, /* 650 */ Tcl_GetStringFromObj, /* 651 */ Tcl_GetUnicodeFromObj, /* 652 */ Tcl_GetByteArrayFromObj, /* 653 */ Tcl_UtfCharComplete, /* 654 */ Tcl_UtfNext, /* 655 */ Tcl_UtfPrev, /* 656 */ }; /* !END!: Do not edit above this line. */ |
Changes to generic/tclStubLib.c.
1 2 3 4 5 6 | /* * tclStubLib.c -- * * Stub object that will be statically linked into extensions that want * to access Tcl. * | | | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | /* * tclStubLib.c -- * * Stub object that will be statically linked into extensions that want * to access Tcl. * * Copyright © 1998-1999 Scriptics Corporation. * Copyright © 1998 Paul Duffin. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" MODULE_SCOPE const TclStubs *tclStubsPtr; MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; MODULE_SCOPE void *tclStubsHandle; const TclStubs *tclStubsPtr = NULL; const TclPlatStubs *tclPlatStubsPtr = NULL; const TclIntStubs *tclIntStubsPtr = NULL; const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; void *tclStubsHandle = NULL; /* * Use our own ISDIGIT to avoid linking to libc on windows */ #define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9) |
︙ | ︙ | |||
50 51 52 53 54 55 56 | MODULE_SCOPE const char * Tcl_InitStubs( Tcl_Interp *interp, const char *version, int exact, int magic) { | | > | | | > > > | 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 | MODULE_SCOPE const char * Tcl_InitStubs( Tcl_Interp *interp, const char *version, int exact, int magic) { Interp *iPtr = (Interp *)interp; const char *actualVersion = NULL; ClientData pkgData = NULL; const TclStubs *stubsPtr = iPtr->stubTable; const char *tclName = (((exact&0xFF00) >= 0x900) ? "tcl" : "Tcl"); /* * We can't optimize this check by caching tclStubsPtr because that * prevents apps from being able to load/unload Tcl dynamically multiple * times. [Bug 615304] */ if (!stubsPtr || (stubsPtr->magic != (((exact&0xFF00) >= 0x900) ? magic : TCL_STUB_MAGIC))) { iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism"; iPtr->legacyFreeProc = 0; /* TCL_STATIC */ return NULL; } actualVersion = stubsPtr->tcl_PkgRequireEx(interp, tclName, version, 0, &pkgData); if (actualVersion == NULL) { return NULL; } if (exact&1) { const char *p = version; int count = 0; while (*p) { count += !ISDIGIT(*p++); } if (count == 1) { const char *q = actualVersion; p = version; while (*p && (*p == *q)) { p++; q++; } if (*p || ISDIGIT(*q)) { /* Construct error message */ stubsPtr->tcl_PkgRequireEx(interp, tclName, version, 1, NULL); return NULL; } } else { actualVersion = stubsPtr->tcl_PkgRequireEx(interp, tclName, version, 1, NULL); if (actualVersion == NULL) { return NULL; } } } if (((exact&0xFF00) < 0x900)) { /* We are running Tcl 8.x */ stubsPtr = (TclStubs *)pkgData; } if (tclStubsHandle == NULL) { tclStubsHandle = INT2PTR(-1); } tclStubsPtr = stubsPtr; if (stubsPtr->hooks) { tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs; tclIntStubsPtr = stubsPtr->hooks->tclIntStubs; tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs; |
︙ | ︙ |
Added generic/tclStubLibTbl.c.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | /* * tclStubLibTbl.c -- * * Stub object that will be statically linked into extensions that want * to access Tcl. * * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 1998 Paul Duffin. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" MODULE_SCOPE void *tclStubsHandle; /* *---------------------------------------------------------------------- * * TclInitStubTable -- * * Initialize the stub table, using the structure pointed at * by the "version" argument. * * Results: * Outputs the value of the "version" argument. * * Side effects: * Sets the stub table pointers. * *---------------------------------------------------------------------- */ MODULE_SCOPE const char * TclInitStubTable( const char *version) /* points to the version field of a structure variable. */ { if (version) { if (tclStubsHandle == NULL) { /* This can only happen with -DBUILD_STATIC, so simulate * that the loading of Tcl succeeded, although we didn't * actually load it dynamically */ tclStubsHandle = (void *)1; } tclStubsPtr = ((const TclStubs **) version)[-1]; if (tclStubsPtr->hooks) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; } else { tclPlatStubsPtr = NULL; tclIntStubsPtr = NULL; tclIntPlatStubsPtr = NULL; } } return version; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclTest.c.
1 2 3 4 5 6 7 8 | /* * tclTest.c -- * * This file contains C command functions for a bunch of additional Tcl * commands that are used for testing out Tcl's C interfaces. These * commands are not normally included in Tcl applications; they're only * used for testing. * | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclTest.c -- * * This file contains C command functions for a bunch of additional Tcl * commands that are used for testing out Tcl's C interfaces. These * commands are not normally included in Tcl applications; they're only * used for testing. * * Copyright © 1993-1994 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 1998-2000 Ajuba Solutions. * Copyright © 2003 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #ifndef USE_TCL_STUBS |
︙ | ︙ | |||
220 221 222 223 224 225 226 227 228 229 230 231 232 233 | static Tcl_CmdProc TestcmdtokenCmd; static Tcl_CmdProc TestcmdtraceCmd; static Tcl_CmdProc TestconcatobjCmd; static Tcl_CmdProc TestcreatecommandCmd; static Tcl_CmdProc TestdcallCmd; static Tcl_CmdProc TestdelCmd; static Tcl_CmdProc TestdelassocdataCmd; static Tcl_ObjCmdProc TestdoubledigitsObjCmd; static Tcl_CmdProc TestdstringCmd; static Tcl_ObjCmdProc TestencodingObjCmd; static Tcl_ObjCmdProc TestevalexObjCmd; static Tcl_ObjCmdProc TestevalobjvObjCmd; static Tcl_ObjCmdProc TesteventObjCmd; static int TesteventProc(Tcl_Event *event, int flags); | > | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 | static Tcl_CmdProc TestcmdtokenCmd; static Tcl_CmdProc TestcmdtraceCmd; static Tcl_CmdProc TestconcatobjCmd; static Tcl_CmdProc TestcreatecommandCmd; static Tcl_CmdProc TestdcallCmd; static Tcl_CmdProc TestdelCmd; static Tcl_CmdProc TestdelassocdataCmd; static Tcl_ObjCmdProc TestdebugObjCmd; static Tcl_ObjCmdProc TestdoubledigitsObjCmd; static Tcl_CmdProc TestdstringCmd; static Tcl_ObjCmdProc TestencodingObjCmd; static Tcl_ObjCmdProc TestevalexObjCmd; static Tcl_ObjCmdProc TestevalobjvObjCmd; static Tcl_ObjCmdProc TesteventObjCmd; static int TesteventProc(Tcl_Event *event, int flags); |
︙ | ︙ | |||
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 | static Tcl_CmdProc TestpanicCmd; static Tcl_ObjCmdProc TestparseargsCmd; static Tcl_ObjCmdProc TestparserObjCmd; static Tcl_ObjCmdProc TestparsevarObjCmd; static Tcl_ObjCmdProc TestparsevarnameObjCmd; static Tcl_ObjCmdProc TestpreferstableObjCmd; static Tcl_ObjCmdProc TestprintObjCmd; static Tcl_ObjCmdProc TestregexpObjCmd; static Tcl_ObjCmdProc TestreturnObjCmd; static void TestregexpXflags(const char *string, size_t length, int *cflagsPtr, int *eflagsPtr); static Tcl_ObjCmdProc TestsaveresultCmd; static void TestsaveresultFree(void *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; | > | | 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 | static Tcl_CmdProc TestpanicCmd; static Tcl_ObjCmdProc TestparseargsCmd; static Tcl_ObjCmdProc TestparserObjCmd; static Tcl_ObjCmdProc TestparsevarObjCmd; static Tcl_ObjCmdProc TestparsevarnameObjCmd; static Tcl_ObjCmdProc TestpreferstableObjCmd; static Tcl_ObjCmdProc TestprintObjCmd; static Tcl_ObjCmdProc TestpurifyObjCmd; static Tcl_ObjCmdProc TestregexpObjCmd; static Tcl_ObjCmdProc TestreturnObjCmd; static void TestregexpXflags(const char *string, size_t length, int *cflagsPtr, int *eflagsPtr); static Tcl_ObjCmdProc TestsaveresultCmd; static void TestsaveresultFree(void *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; |
︙ | ︙ | |||
456 457 458 459 460 461 462 | } #endif if (Tcl_OOInitStubs(interp) == NULL) { return TCL_ERROR; } /* TIP #268: Full patchlevel instead of just major.minor */ | | | 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 | } #endif if (Tcl_OOInitStubs(interp) == NULL) { return TCL_ERROR; } /* TIP #268: Full patchlevel instead of just major.minor */ if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } /* * Create additional commands and math functions for testing Tcl. */ |
︙ | ︙ | |||
497 498 499 500 501 502 503 504 505 506 507 508 509 510 | Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd, NULL, NULL); Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd, NULL, NULL); Tcl_DStringInit(&dstring); Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL, | > > | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 | Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd, NULL, NULL); Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testdebug", TestdebugObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd, NULL, NULL); Tcl_DStringInit(&dstring); Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL, |
︙ | ︙ | |||
561 562 563 564 565 566 567 568 569 570 571 572 573 574 | NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, | > > | 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 | NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpurify", TestpurifyObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, |
︙ | ︙ | |||
597 598 599 600 601 602 603 | TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", TestFindLastCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsocket", TestSocketCmd, NULL, NULL); | | | 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 | TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", TestFindLastCmd, 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, |
︙ | ︙ | |||
3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 | } return TCL_OK; } /* *---------------------------------------------------------------------- * * CleanupTestSetassocdataTests -- * * This function is called when an interpreter is deleted to clean * up any data left over from running the testsetassocdata command. * * Results: * None. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | } return TCL_OK; } /* *---------------------------------------------------------------------- * * TestdebugObjCmd -- * * Implements the "testdebug" command, to detect whether Tcl was built with * --enabble-symbols. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestdebugObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { #if defined(NDEBUG) && NDEBUG == 1 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); #else Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); #endif return TCL_OK; } /* *---------------------------------------------------------------------- * * CleanupTestSetassocdataTests -- * * This function is called when an interpreter is deleted to clean * up any data left over from running the testsetassocdata command. * * Results: * None. |
︙ | ︙ | |||
3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 | } if (objc > 1) { Tcl_GetWideIntFromObj(interp, objv[2], &argv1); } argv2 = (size_t)argv1; Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestregexpObjCmd -- | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | } if (objc > 1) { Tcl_GetWideIntFromObj(interp, objv[2], &argv1); } argv2 = (size_t)argv1; Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TestpurifyObjCmd -- * * Implements the "testpurify" command, to detect whether Tcl was built with * -DPURIFY. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestpurifyObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { #ifdef PURIFY Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); #else Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); #endif return TCL_OK; } /* *---------------------------------------------------------------------- * * TestregexpObjCmd -- |
︙ | ︙ | |||
4213 4214 4215 4216 4217 4218 4219 | } return TCL_OK; } /* *---------------------------------------------------------------------- * | | | | | | | | 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 | } 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 |
︙ | ︙ | |||
4769 4770 4771 4772 4773 4774 4775 | } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000); Tcl_Free(objv); /* TclGetString 100000 times */ | | | | 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 | } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000); Tcl_Free(objv); /* TclGetString 100000 times */ fprintf(stderr, "Tcl_GetStringFromObj of \"12345\" 100000 times\n"); objPtr = Tcl_NewStringObj("12345", -1); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { (void) TclGetString(objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_GetStringFromObj of \"12345\"\n", timePer/100000); /* Tcl_GetIntFromObj 100000 times */ fprintf(stderr, "Tcl_GetIntFromObj of \"12345\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { if (Tcl_GetIntFromObj(interp, objPtr, &n) != TCL_OK) { |
︙ | ︙ | |||
6910 6911 6912 6913 6914 6915 6916 | } } p = tobetested; while ((buffer[numBytes + 1] = *p++) != '\0') { /* Run Tcl_UtfNext with many more possible bytes at src[end], all should give the same result */ result = Tcl_UtfNext(buffer + 1); if (first != result) { | > > | | | 6984 6985 6986 6987 6988 6989 6990 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 | } } p = tobetested; while ((buffer[numBytes + 1] = *p++) != '\0') { /* Run Tcl_UtfNext with many more possible bytes at src[end], all should give the same result */ result = Tcl_UtfNext(buffer + 1); if (first != result) { 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_NewIntObj(first - buffer - 1)); return TCL_OK; } |
︙ | ︙ | |||
6957 6958 6959 6960 6961 6962 6963 | } if (offset > numBytes) { offset = numBytes; } } else { offset = numBytes; } | | | 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046 7047 | } 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 */ |
︙ | ︙ |
Changes to generic/tclTestObj.c.
1 2 3 4 5 6 7 8 | /* * tclTestObj.c -- * * This file contains C command functions for the additional Tcl commands * that are used for testing implementations of the Tcl object types. * These commands are not normally included in Tcl applications; they're * only used for testing. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * tclTestObj.c -- * * This file contains C command functions for the additional Tcl commands * that are used for testing implementations of the Tcl object types. * These commands are not normally included in Tcl applications; they're * only used for testing. * * Copyright © 1995-1998 Sun Microsystems, Inc. * Copyright © 1999 Scriptics Corporation. * Copyright © 2005 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS |
︙ | ︙ | |||
1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *unicode; int varIndex, option, i, length; #define MAX_STRINGS 11 const char *index, *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", | > | 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *unicode; int varIndex, option, i, length; size_t size; #define MAX_STRINGS 11 const char *index, *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", |
︙ | ︙ | |||
1296 1297 1298 1299 1300 1301 1302 | * 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". */ | | | | | 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 | * 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". */ string = Tcl_GetStringFromObj(objv[3], &size); if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetStringObj(varPtr[varIndex], string, size); } else { SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, size)); } Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 7: /* set2 */ if (objc != 4) { goto wrongNumArgs; } |
︙ | ︙ | |||
1353 1354 1355 1356 1357 1358 1359 | * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } | | | | | | | | 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 | * "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_GetIntFromObj(interp, objv[3], &i) != TCL_OK) { return TCL_ERROR; } if ((i < 0) || ((size_t)i > size)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendToObj(varPtr[varIndex], string + i, size - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 11: /* appendself2 */ 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])); } unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size); if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) { return TCL_ERROR; } if ((i < 0) || ((size_t)i > size)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; } TclAppendUnicodeToObj(varPtr[varIndex], unicode + i, size - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; } return TCL_OK; } |
︙ | ︙ |
Changes to generic/tclTestProcBodyObj.c.
1 2 3 4 5 6 7 | /* * tclTestProcBodyObj.c -- * * Implements the "procbodytest" package, which contains commands to test * creation of Tcl procedures whose body argument is a Tcl_Obj of type * "procbody" rather than a string. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | /* * tclTestProcBodyObj.c -- * * Implements the "procbodytest" package, which contains commands to test * creation of Tcl procedures whose body argument is a Tcl_Obj of type * "procbody" rather than a string. * * Copyright © 1998 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" /* * name and version of this package */ static const char packageName[] = "tcl::procbodytest"; static const char packageVersion[] = "1.1"; /* * Name of the commands exported by this package */ static const char procCommand[] = "proc"; |
︙ | ︙ | |||
71 72 73 74 75 76 77 | }; /* *---------------------------------------------------------------------- * * Procbodytest_Init -- * | | | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | }; /* *---------------------------------------------------------------------- * * Procbodytest_Init -- * * This function initializes the "tcl::procbodytest" package. * * Results: * A standard Tcl result. * * Side effects: * None. * |
︙ | ︙ | |||
95 96 97 98 99 100 101 | } /* *---------------------------------------------------------------------- * * Procbodytest_SafeInit -- * | | | 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | } /* *---------------------------------------------------------------------- * * Procbodytest_SafeInit -- * * This function initializes the "tcl::procbodytest" package. * * Results: * A standard Tcl result. * * Side effects: * None. * |
︙ | ︙ | |||
311 312 313 314 315 316 317 | * ProcBodyTestCheckObjCmd -- * * Implements the "procbodytest::check" command. Here is the command * description: * procbodytest::check * * Performs an internal check that the Tcl_PkgPresent() command returns | | | 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 | * ProcBodyTestCheckObjCmd -- * * Implements the "procbodytest::check" command. Here is the command * description: * procbodytest::check * * Performs an internal check that the Tcl_PkgPresent() command returns * the same version number as was registered when the tcl::procbodytest package * was provided. Places a boolean in the interp result indicating the * test outcome. * * Results: * Returns a standard Tcl code. * *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclThread.c.
1 2 3 4 5 6 | /* * tclThread.c -- * * This file implements Platform independent thread operations. Most of * the real work is done in the platform dependent files. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclThread.c -- * * This file implements Platform independent thread operations. Most of * the real work is done in the platform dependent files. * * Copyright © 1998 Sun Microsystems, Inc. * Copyright © 2008 George Peter Staplin * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclThreadAlloc.c.
1 2 3 4 5 6 7 8 | /* * tclThreadAlloc.c -- * * This is a very fast storage allocator for used with threads (designed * avoid lock contention). The basic strategy is to allocate memory in * fixed size blocks from block caches. * * The Initial Developer of the Original Code is America Online, Inc. | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclThreadAlloc.c -- * * This is a very fast storage allocator for used with threads (designed * avoid lock contention). The basic strategy is to allocate memory in * fixed size blocks from block caches. * * The Initial Developer of the Original Code is America Online, Inc. * Portions created by AOL are Copyright © 1999 America Online, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #if TCL_THREADS && defined(USE_THREAD_ALLOC) |
︙ | ︙ | |||
87 88 89 90 91 92 93 | Block *lastPtr; /* End of block list */ size_t numFree; /* Number of blocks available */ /* All fields below for accounting only */ size_t numRemoves; /* Number of removes from bucket */ size_t numInserts; /* Number of inserts into bucket */ | < | | | | 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 | Block *lastPtr; /* End of block list */ size_t numFree; /* Number of blocks available */ /* All fields below for accounting only */ size_t numRemoves; /* Number of removes from bucket */ size_t numInserts; /* Number of inserts into bucket */ size_t numLocks; /* Number of locks acquired */ size_t totalAssigned; /* Total space assigned to bucket */ } Bucket; /* * The following structure defines a cache of buckets and objs, of which there * will be (at most) one per thread. Any changes need to be reflected in the * struct AllocCache defined in tclInt.h, possibly also in the initialisation * code in Tcl_CreateInterp(). */ typedef struct Cache { struct Cache *nextPtr; /* Linked list of cache entries */ Tcl_ThreadId owner; /* Which thread's cache is this? */ Tcl_Obj *firstObjPtr; /* List of free objects for thread */ size_t numObjects; /* Number of objects for thread */ Tcl_Obj *lastPtr; /* Last object in this cache */ size_t totalAssigned; /* Total space assigned to thread */ Bucket buckets[NBUCKETS]; /* The buckets for this thread */ } Cache; /* * The following array specifies various per-bucket limits and locks. The * values are statically initialized to avoid calculating them repeatedly. */ |
︙ | ︙ | |||
128 129 130 131 132 133 134 | /* * Static functions defined in this file. */ static Cache * GetCache(void); static void LockBucket(Cache *cachePtr, int bucket); static void UnlockBucket(Cache *cachePtr, int bucket); | | | | | | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | /* * Static functions defined in this file. */ static Cache * GetCache(void); static void LockBucket(Cache *cachePtr, int bucket); static void UnlockBucket(Cache *cachePtr, int bucket); static void PutBlocks(Cache *cachePtr, int bucket, size_t numMove); static int GetBlocks(Cache *cachePtr, int bucket); static Block * Ptr2Block(void *ptr); static void * Block2Ptr(Block *blockPtr, int bucket, size_t reqSize); static void MoveObjs(Cache *fromPtr, Cache *toPtr, size_t numMove); static void PutObjs(Cache *fromPtr, size_t numMove); /* * Local variables defined in this file and initialized at startup. */ static Tcl_Mutex *listLockPtr; static Tcl_Mutex *objLockPtr; |
︙ | ︙ | |||
518 519 520 521 522 523 524 | /* * Get this thread's obj list structure and move or allocate new objs if * necessary. */ if (cachePtr->numObjects == 0) { | | | | | 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 | /* * Get this thread's obj list structure and move or allocate new objs if * necessary. */ if (cachePtr->numObjects == 0) { size_t numMove; Tcl_MutexLock(objLockPtr); numMove = sharedPtr->numObjects; if (numMove > 0) { if (numMove > NOBJALLOC) { numMove = NOBJALLOC; } MoveObjs(sharedPtr, cachePtr, numMove); } Tcl_MutexUnlock(objLockPtr); if (cachePtr->numObjects == 0) { Tcl_Obj *newObjsPtr; cachePtr->numObjects = numMove = NOBJALLOC; newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove); if (newObjsPtr == NULL) { Tcl_Panic("alloc: could not allocate %" TCL_Z_MODIFIER "u new objects", numMove); } cachePtr->lastPtr = newObjsPtr + numMove - 1; objPtr = cachePtr->firstObjPtr; /* NULL */ while (numMove-- > 0) { newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr; objPtr = newObjsPtr + numMove; } cachePtr->firstObjPtr = newObjsPtr; } } |
︙ | ︙ | |||
641 642 643 644 645 646 647 | if (cachePtr == sharedPtr) { Tcl_DStringAppendElement(dsPtr, "shared"); } else { sprintf(buf, "thread%p", cachePtr->owner); Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { | | > | < | 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 | if (cachePtr == sharedPtr) { Tcl_DStringAppendElement(dsPtr, "shared"); } else { sprintf(buf, "thread%p", cachePtr->owner); Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u", bucketInfo[n].blockSize, cachePtr->buckets[n].numFree, cachePtr->buckets[n].numRemoves, cachePtr->buckets[n].numInserts, cachePtr->buckets[n].totalAssigned, cachePtr->buckets[n].numLocks); Tcl_DStringAppendElement(dsPtr, buf); } Tcl_DStringEndSublist(dsPtr); cachePtr = cachePtr->nextPtr; } Tcl_MutexUnlock(listLockPtr); } |
︙ | ︙ | |||
677 678 679 680 681 682 683 | *---------------------------------------------------------------------- */ static void MoveObjs( Cache *fromPtr, Cache *toPtr, | | | | 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 | *---------------------------------------------------------------------- */ static void MoveObjs( Cache *fromPtr, Cache *toPtr, size_t numMove) { Tcl_Obj *objPtr = fromPtr->firstObjPtr; Tcl_Obj *fromFirstObjPtr = objPtr; toPtr->numObjects += numMove; fromPtr->numObjects -= numMove; /* * Find the last object to be moved; set the next one (the first one not * to be moved) as the first object in the 'from' cache. */ while (numMove-- > 1) { objPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1; } fromPtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1; /* * Move all objects as a block - they are already linked to each other, we * just have to update the first and last. |
︙ | ︙ | |||
724 725 726 727 728 729 730 | * *---------------------------------------------------------------------- */ static void PutObjs( Cache *fromPtr, | | | | | 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 | * *---------------------------------------------------------------------- */ static void PutObjs( Cache *fromPtr, size_t numMove) { size_t keep = fromPtr->numObjects - numMove; Tcl_Obj *firstPtr, *lastPtr = NULL; fromPtr->numObjects = keep; firstPtr = fromPtr->firstObjPtr; if (keep == 0) { fromPtr->firstObjPtr = NULL; } else { do { lastPtr = firstPtr; firstPtr = (Tcl_Obj *)firstPtr->internalRep.twoPtrValue.ptr1; } while (keep-- > 1); lastPtr->internalRep.twoPtrValue.ptr1 = NULL; } /* * Move all objects as a block - they are already linked to each other, we * just have to update the first and last. */ |
︙ | ︙ | |||
778 779 780 781 782 783 784 | *---------------------------------------------------------------------- */ static void * Block2Ptr( Block *blockPtr, int bucket, | | | 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 | *---------------------------------------------------------------------- */ static void * Block2Ptr( Block *blockPtr, int bucket, size_t reqSize) { void *ptr; blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC; blockPtr->sourceBucket = bucket; blockPtr->blockReqSize = reqSize; ptr = ((void *) (blockPtr + 1)); |
︙ | ︙ | |||
868 869 870 871 872 873 874 | *---------------------------------------------------------------------- */ static void PutBlocks( Cache *cachePtr, int bucket, | | | | | 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 | *---------------------------------------------------------------------- */ static void PutBlocks( Cache *cachePtr, int bucket, size_t numMove) { /* * We have numFree. Want to shed numMove. So compute how many * Blocks to keep. */ size_t keep = cachePtr->buckets[bucket].numFree - numMove; Block *lastPtr = NULL, *firstPtr; cachePtr->buckets[bucket].numFree = keep; firstPtr = cachePtr->buckets[bucket].firstPtr; if (keep == 0) { cachePtr->buckets[bucket].firstPtr = NULL; } else { do { lastPtr = firstPtr; firstPtr = firstPtr->nextBlock; } while (keep-- > 1); lastPtr->nextBlock = NULL; } /* * Aquire the lock and place the list of blocks at the front of the shared * cache bucket. */ |
︙ | ︙ | |||
964 965 966 967 968 969 970 | sharedPtr->buckets[bucket].firstPtr = NULL; sharedPtr->buckets[bucket].numFree = 0; } else { blockPtr = sharedPtr->buckets[bucket].firstPtr; cachePtr->buckets[bucket].firstPtr = blockPtr; sharedPtr->buckets[bucket].numFree -= n; cachePtr->buckets[bucket].numFree = n; | | | 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 | sharedPtr->buckets[bucket].firstPtr = NULL; sharedPtr->buckets[bucket].numFree = 0; } else { blockPtr = sharedPtr->buckets[bucket].firstPtr; cachePtr->buckets[bucket].firstPtr = blockPtr; sharedPtr->buckets[bucket].numFree -= n; cachePtr->buckets[bucket].numFree = n; while (n-- > 1) { blockPtr = blockPtr->nextBlock; } sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock; cachePtr->buckets[bucket].lastPtr = blockPtr; blockPtr->nextBlock = NULL; } } |
︙ | ︙ | |||
986 987 988 989 990 991 992 | * If no blocks could be moved from shared, first look for a larger * block in this cache to split up. */ blockPtr = NULL; n = NBUCKETS; size = 0; | | | 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 | * If no blocks could be moved from shared, first look for a larger * block in this cache to split up. */ blockPtr = NULL; n = NBUCKETS; size = 0; while (n-- > (size_t)bucket + 1) { if (cachePtr->buckets[n].numFree > 0) { size = bucketInfo[n].blockSize; blockPtr = cachePtr->buckets[n].firstPtr; cachePtr->buckets[n].firstPtr = blockPtr->nextBlock; cachePtr->buckets[n].numFree--; break; } |
︙ | ︙ | |||
1015 1016 1017 1018 1019 1020 1021 | /* * Split the larger block into smaller blocks for this bucket. */ n = size / bucketInfo[bucket].blockSize; cachePtr->buckets[bucket].numFree = n; cachePtr->buckets[bucket].firstPtr = blockPtr; | | | 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 | /* * Split the larger block into smaller blocks for this bucket. */ n = size / bucketInfo[bucket].blockSize; cachePtr->buckets[bucket].numFree = n; cachePtr->buckets[bucket].firstPtr = blockPtr; while (n-- > 1) { blockPtr->nextBlock = (Block *) ((char *) blockPtr + bucketInfo[bucket].blockSize); blockPtr = blockPtr->nextBlock; } cachePtr->buckets[bucket].lastPtr = blockPtr; blockPtr->nextBlock = NULL; } |
︙ | ︙ | |||
1054 1055 1056 1057 1058 1059 1060 | listLockPtr = TclpNewAllocMutex(); objLockPtr = TclpNewAllocMutex(); for (i = 0; i < NBUCKETS; ++i) { bucketInfo[i].blockSize = MINALLOC << i; bucketInfo[i].maxBlocks = ((size_t)1) << (NBUCKETS - 1 - i); bucketInfo[i].numMove = i < NBUCKETS - 1 ? | | | 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 | listLockPtr = TclpNewAllocMutex(); objLockPtr = TclpNewAllocMutex(); for (i = 0; i < NBUCKETS; ++i) { bucketInfo[i].blockSize = MINALLOC << i; bucketInfo[i].maxBlocks = ((size_t)1) << (NBUCKETS - 1 - i); bucketInfo[i].numMove = i < NBUCKETS - 1 ? (size_t)1 << (NBUCKETS - 2 - i) : 1; bucketInfo[i].lockPtr = TclpNewAllocMutex(); } TclpInitAllocCache(); } /* *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclThreadJoin.c.
1 2 3 4 5 6 7 8 | /* * tclThreadJoin.c -- * * This file implements a platform independent emulation layer for the * handling of joinable threads. The Windows platform uses this code to * provide the functionality of joining threads. This code is currently * not necessary on Unix. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclThreadJoin.c -- * * This file implements a platform independent emulation layer for the * handling of joinable threads. The Windows platform uses this code to * provide the functionality of joining threads. This code is currently * not necessary on Unix. * * Copyright © 2000 Scriptics Corporation * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
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); } #endif /* _WIN32 */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ | > > | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 | 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 * End: */ |
Changes to generic/tclThreadStorage.c.
1 2 3 4 5 6 | /* * tclThreadStorage.c -- * * This file implements platform independent thread storage operations to * work around system limits on the number of thread-specific variables. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclThreadStorage.c -- * * This file implements platform independent thread storage operations to * work around system limits on the number of thread-specific variables. * * Copyright © 2003-2004 Joe Mistachkin * Copyright © 2008 George Peter Staplin * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to generic/tclThreadTest.c.
1 2 3 4 5 6 7 8 | /* * tclThreadTest.c -- * * This file implements the testthread command. Eventually this should be * tclThreadCmd.c * Some of this code is based on work done by Richard Hipp on behalf of * Conservation Through Innovation, Limited, with their permission. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclThreadTest.c -- * * This file implements the testthread command. Eventually this should be * tclThreadCmd.c * Some of this code is based on work done by Richard Hipp on behalf of * Conservation Through Innovation, Limited, with their permission. * * Copyright © 1998 Sun Microsystems, Inc. * Copyright © 2006-2008 Joe Mistachkin. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS |
︙ | ︙ | |||
364 365 366 367 368 369 370 | return TCL_ERROR; } result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), status); } else { | | | | 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 | return TCL_ERROR; } result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), status); } else { char buf[TCL_INTEGER_SPACE]; sprintf(buf, "%" TCL_LL_MODIFIER "d", (long long)id); Tcl_AppendResult(interp, "cannot join thread ", buf, NULL); } return result; } case THREAD_NAMES: if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); |
︙ | ︙ |
Changes to generic/tclTimer.c.
1 2 3 4 5 6 | /* * tclTimer.c -- * * This file provides timer event management facilities for Tcl, * including the "after" command. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclTimer.c -- * * This file provides timer event management facilities for Tcl, * including the "after" command. * * Copyright © 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
889 890 891 892 893 894 895 | return TCL_ERROR; } if (objc == 3) { commandPtr = objv[2]; } else { commandPtr = Tcl_ConcatObj(objc-2, objv+2); } | | | | 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 | return TCL_ERROR; } if (objc == 3) { commandPtr = objv[2]; } else { commandPtr = Tcl_ConcatObj(objc-2, objv+2); } command = Tcl_GetStringFromObj(commandPtr, &length); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr, &tempLength); if ((length == tempLength) && !memcmp(command, tempCommand, length)) { break; } } if (afterPtr == NULL) { |
︙ | ︙ |
Changes to generic/tclTomMath.decls.
1 2 3 4 5 6 7 8 9 | # tclTomMath.decls -- # # This file contains the declarations for the functions in 'libtommath' # that are contained within the Tcl library. This file is used to # generate the 'tclTomMathDecls.h' and 'tclStubInit.c' files. # # If you edit this file, advance the revision number (and the epoch # if the new stubs are not backward compatible) in tclTomMathDecls.h # | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # tclTomMath.decls -- # # This file contains the declarations for the functions in 'libtommath' # that are contained within the Tcl library. This file is used to # generate the 'tclTomMathDecls.h' and 'tclStubInit.c' files. # # If you edit this file, advance the revision number (and the epoch # if the new stubs are not backward compatible) in tclTomMathDecls.h # # Copyright © 2005 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. library tcl # Define the unsupported generic interfaces. interface tclTomMath scspec EXTERN # Declare each of the functions in the Tcl tommath interface declare 0 { int MP_WUR TclBN_epoch(void) } |
︙ | ︙ | |||
212 213 214 215 216 217 218 219 220 221 222 223 224 225 | } declare 69 { uint64_t MP_WUR TclBN_mp_get_mag_u64(const mp_int *a) } declare 70 { void TclBN_mp_set_i64(mp_int *a, int64_t i) } # Added in libtommath 1.1.0 # No longer in use: replaced by mp_and() #declare 73 { # int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) #} # No longer in use: replaced by mp_or() | > > > > | 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 | } declare 69 { uint64_t MP_WUR TclBN_mp_get_mag_u64(const mp_int *a) } declare 70 { void TclBN_mp_set_i64(mp_int *a, int64_t i) } declare 71 { mp_err MP_WUR TclBN_mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) } # Added in libtommath 1.1.0 # No longer in use: replaced by mp_and() #declare 73 { # int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) #} # No longer in use: replaced by mp_or() |
︙ | ︙ |
Changes to generic/tclTomMathDecls.h.
︙ | ︙ | |||
49 50 51 52 53 54 55 | #undef MP_FREE #define MP_MALLOC(size) TclBNAlloc(size) #define MP_CALLOC(nmemb, size) TclBNCalloc(nmemb, size) #define MP_REALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize) #define MP_FREE(mem, size) TclBNFree(mem) #ifndef MODULE_SCOPE | > > > | > > > > > > > > > > > > > > > > > | 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 | #undef MP_FREE #define MP_MALLOC(size) TclBNAlloc(size) #define MP_CALLOC(nmemb, size) TclBNCalloc(nmemb, size) #define MP_REALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize) #define MP_FREE(mem, size) TclBNFree(mem) #ifndef MODULE_SCOPE # ifdef __cplusplus # define MODULE_SCOPE extern "C" # else # define MODULE_SCOPE extern # endif #endif #ifdef __cplusplus extern "C" { #endif MODULE_SCOPE mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b); MODULE_SCOPE mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r); MODULE_SCOPE mp_err TclBN_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c); MODULE_SCOPE mp_err TclBN_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c); MODULE_SCOPE mp_err TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b); MODULE_SCOPE mp_err TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c); MODULE_SCOPE mp_err TclBN_mp_toom_sqr(const mp_int *a, mp_int *b); MODULE_SCOPE mp_err TclBN_s_mp_add(const mp_int *a, const mp_int *b, mp_int *c); MODULE_SCOPE mp_err TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); MODULE_SCOPE mp_err TclBN_s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs); MODULE_SCOPE void TclBN_s_mp_reverse(unsigned char *s, size_t len); MODULE_SCOPE mp_err TclBN_s_mp_sqr(const mp_int *a, mp_int *b); MODULE_SCOPE mp_err TclBN_s_mp_sqr_fast(const mp_int *a, mp_int *b); MODULE_SCOPE mp_err TclBN_s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c); MODULE_SCOPE const char *const TclBN_mp_s_rmap; MODULE_SCOPE const uint8_t TclBN_mp_s_rmap_reverse[]; MODULE_SCOPE const size_t TclBN_mp_s_rmap_reverse_sz; MODULE_SCOPE mp_err TclBN_mp_set_int(mp_int *a, unsigned long b); #ifdef __cplusplus } #endif /* Rename the global symbols in libtommath to avoid linkage conflicts */ #ifndef TCL_WITH_EXTERNAL_TOMMATH |
︙ | ︙ | |||
129 130 131 132 133 134 135 136 137 138 139 140 141 142 | #define mp_tc_xor TclBN_mp_xor #define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin #define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n #define mp_toradix_n TclBN_mp_toradix_n #define mp_to_radix TclBN_mp_to_radix #define mp_to_ubin TclBN_mp_to_ubin #define mp_ubin_size TclBN_mp_ubin_size #define mp_xor TclBN_mp_xor #define mp_zero TclBN_mp_zero #define s_mp_add TclBN_s_mp_add #define s_mp_balance_mul TclBN_mp_balance_mul #define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul #define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr #define s_mp_mul_digs TclBN_s_mp_mul_digs | > | 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | #define mp_tc_xor TclBN_mp_xor #define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin #define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n #define mp_toradix_n TclBN_mp_toradix_n #define mp_to_radix TclBN_mp_to_radix #define mp_to_ubin TclBN_mp_to_ubin #define mp_ubin_size TclBN_mp_ubin_size #define mp_unpack TclBN_mp_unpack #define mp_xor TclBN_mp_xor #define mp_zero TclBN_mp_zero #define s_mp_add TclBN_s_mp_add #define s_mp_balance_mul TclBN_mp_balance_mul #define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul #define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr #define s_mp_mul_digs TclBN_s_mp_mul_digs |
︙ | ︙ | |||
309 310 311 312 313 314 315 | /* Slot 67 is reserved */ /* 68 */ EXTERN void TclBN_mp_set_u64(mp_int *a, uint64_t i); /* 69 */ EXTERN uint64_t TclBN_mp_get_mag_u64(const mp_int *a) MP_WUR; /* 70 */ EXTERN void TclBN_mp_set_i64(mp_int *a, int64_t i); | | > > > > | 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 | /* Slot 67 is reserved */ /* 68 */ EXTERN void TclBN_mp_set_u64(mp_int *a, uint64_t i); /* 69 */ EXTERN uint64_t TclBN_mp_get_mag_u64(const mp_int *a) MP_WUR; /* 70 */ EXTERN void TclBN_mp_set_i64(mp_int *a, int64_t i); /* 71 */ EXTERN mp_err TclBN_mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) MP_WUR; /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* Slot 74 is reserved */ /* Slot 75 is reserved */ /* 76 */ EXTERN mp_err TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) MP_WUR; |
︙ | ︙ | |||
401 402 403 404 405 406 407 | void (*reserved64)(void); int (*tclBN_mp_init_i64) (mp_int *bignum, int64_t initVal) MP_WUR; /* 65 */ int (*tclBN_mp_init_u64) (mp_int *bignum, uint64_t initVal) MP_WUR; /* 66 */ void (*reserved67)(void); void (*tclBN_mp_set_u64) (mp_int *a, uint64_t i); /* 68 */ uint64_t (*tclBN_mp_get_mag_u64) (const mp_int *a) MP_WUR; /* 69 */ void (*tclBN_mp_set_i64) (mp_int *a, int64_t i); /* 70 */ | | | 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 | void (*reserved64)(void); int (*tclBN_mp_init_i64) (mp_int *bignum, int64_t initVal) MP_WUR; /* 65 */ int (*tclBN_mp_init_u64) (mp_int *bignum, uint64_t initVal) MP_WUR; /* 66 */ void (*reserved67)(void); void (*tclBN_mp_set_u64) (mp_int *a, uint64_t i); /* 68 */ uint64_t (*tclBN_mp_get_mag_u64) (const mp_int *a) MP_WUR; /* 69 */ void (*tclBN_mp_set_i64) (mp_int *a, int64_t i); /* 70 */ mp_err (*tclBN_mp_unpack) (mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) MP_WUR; /* 71 */ void (*reserved72)(void); void (*reserved73)(void); void (*reserved74)(void); void (*reserved75)(void); mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c) MP_WUR; /* 76 */ void (*reserved77)(void); int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; /* 78 */ |
︙ | ︙ | |||
546 547 548 549 550 551 552 | /* Slot 67 is reserved */ #define TclBN_mp_set_u64 \ (tclTomMathStubsPtr->tclBN_mp_set_u64) /* 68 */ #define TclBN_mp_get_mag_u64 \ (tclTomMathStubsPtr->tclBN_mp_get_mag_u64) /* 69 */ #define TclBN_mp_set_i64 \ (tclTomMathStubsPtr->tclBN_mp_set_i64) /* 70 */ | | > | 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 | /* Slot 67 is reserved */ #define TclBN_mp_set_u64 \ (tclTomMathStubsPtr->tclBN_mp_set_u64) /* 68 */ #define TclBN_mp_get_mag_u64 \ (tclTomMathStubsPtr->tclBN_mp_get_mag_u64) /* 69 */ #define TclBN_mp_set_i64 \ (tclTomMathStubsPtr->tclBN_mp_set_i64) /* 70 */ #define TclBN_mp_unpack \ (tclTomMathStubsPtr->tclBN_mp_unpack) /* 71 */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* Slot 74 is reserved */ /* Slot 75 is reserved */ #define TclBN_mp_signed_rsh \ (tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */ /* Slot 77 is reserved */ |
︙ | ︙ |
Changes to generic/tclTomMathInterface.c.
1 2 3 4 5 6 7 8 | /* *---------------------------------------------------------------------- * * tclTomMathInterface.c -- * * This file contains procedures that are used as a 'glue' layer between * Tcl and libtommath. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* *---------------------------------------------------------------------- * * tclTomMathInterface.c -- * * This file contains procedures that are used as a 'glue' layer between * Tcl and libtommath. * * Copyright © 2005 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" |
︙ | ︙ |
Changes to generic/tclTomMathStubLib.c.
1 2 3 4 5 6 | /* * tclTomMathStubLib.c -- * * Stub object that will be statically linked into extensions that want * to access Tcl. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclTomMathStubLib.c -- * * Stub object that will be statically linked into extensions that want * to access Tcl. * * Copyright © 1998-1999 Scriptics Corporation. * Copyright © 1998 Paul Duffin. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" |
︙ | ︙ |
Changes to generic/tclTrace.c.
1 2 3 4 5 | /* * tclTrace.c -- * * This file contains code to handle most trace management. * | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclTrace.c -- * * This file contains code to handle most trace management. * * Copyright © 1987-1993 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 1998-2000 Scriptics Corporation. * Copyright © 2002 ActiveState Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
275 276 277 278 279 280 281 | if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); return TCL_ERROR; } TclNewObj(opsList); Tcl_IncrRefCount(opsList); | | | 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 | if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); return TCL_ERROR; } TclNewObj(opsList); Tcl_IncrRefCount(opsList); flagOps = Tcl_GetStringFromObj(objv[3], &numFlags); if (numFlags == 0) { Tcl_DecrRefCount(opsList); goto badVarOps; } for (p = flagOps; *p != 0; p++) { Tcl_Obj *opObj; |
︙ | ︙ | |||
461 462 463 464 465 466 467 | flags |= TCL_TRACE_ENTER_DURING_EXEC; break; case TRACE_EXEC_LEAVE_STEP: flags |= TCL_TRACE_LEAVE_DURING_EXEC; break; } } | | | 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 | flags |= TCL_TRACE_ENTER_DURING_EXEC; break; case TRACE_EXEC_LEAVE_STEP: flags |= TCL_TRACE_LEAVE_DURING_EXEC; break; } } command = Tcl_GetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; |
︙ | ︙ | |||
698 699 700 701 702 703 704 | break; case TRACE_CMD_DELETE: flags |= TCL_TRACE_DELETE; break; } } | | | 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 | break; case TRACE_CMD_DELETE: flags |= TCL_TRACE_DELETE; break; } } command = Tcl_GetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; |
︙ | ︙ | |||
901 902 903 904 905 906 907 | flags |= TCL_TRACE_UNSETS; break; case TRACE_VAR_WRITE: flags |= TCL_TRACE_WRITES; break; } } | | | 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 | flags |= TCL_TRACE_UNSETS; break; case TRACE_VAR_WRITE: flags |= TCL_TRACE_WRITES; break; } } command = Tcl_GetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc( offsetof(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); ctvarPtr->traceCmdInfo.flags = flags; |
︙ | ︙ |
Changes to generic/tclUniData.c.
1 2 3 4 5 6 7 | /* * tclUniData.c -- * * Declarations of Unicode character information tables. This file is * automatically generated by the tools/uniParse.tcl script. Do not * modify this file by hand. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * 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 generic/tclUtf.c.
1 2 3 4 5 | /* * tclUtf.c -- * * Routines for manipulating UTF-8 strings. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclUtf.c -- * * Routines for manipulating UTF-8 strings. * * Copyright © 1997-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
60 61 62 63 64 65 66 | */ static const unsigned char totalBytes[256] = { 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, | < > | < < | < < < < < < | | < < < < < < | | 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 | */ static const unsigned char totalBytes[256] = { 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,1,1,1,1,1,1,1,1,1,1,1 }; static const unsigned char complete[256] = { 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* Tcl_UtfCharComplete() might point to 2nd byte of valid 4-byte sequence */ 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, /* End of "continuation byte section" */ 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,1,1,1,1,1,1,1,1,1,1,1 }; /* * Functions used only in this module. */ static int Invalid(const char *src); /* |
︙ | ︙ | |||
691 692 693 694 695 696 697 | p = src; endPtr = src + length; optPtr = endPtr - 4; while (p <= optPtr) { p += TclUtfToUCS4(p, &ch); *w++ = ch; } | | | 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 | p = src; endPtr = src + length; optPtr = endPtr - 4; while (p <= optPtr) { p += TclUtfToUCS4(p, &ch); *w++ = ch; } while ((p < endPtr) && Tcl_UtfCharComplete(p, endPtr-p)) { p += TclUtfToUCS4(p, &ch); *w++ = ch; } while (p < endPtr) { *w++ = UCHAR(*p++); } *w = '\0'; |
︙ | ︙ | |||
749 750 751 752 753 754 755 | endPtr = src + length; optPtr = endPtr - 3; while (p <= optPtr) { p += Tcl_UtfToChar16(p, &ch); *w++ = ch; } while (p < endPtr) { | | | 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 | endPtr = src + length; optPtr = endPtr - 3; while (p <= optPtr) { p += Tcl_UtfToChar16(p, &ch); *w++ = ch; } while (p < endPtr) { if (Tcl_UtfCharComplete(p, endPtr-p)) { p += Tcl_UtfToChar16(p, &ch); *w++ = ch; } else { *w++ = UCHAR(*p++); } } *w = '\0'; |
︙ | ︙ | |||
830 831 832 833 834 835 836 | } } else { /* Will return value between 0 and length. No overflow checks. */ /* Pointer to the end of string. Never read endPtr[0] */ const char *endPtr = src + length; /* Pointer to last byte where optimization still can be used */ | | | 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 | } } else { /* Will return value between 0 and length. No overflow checks. */ /* Pointer to the end of string. Never read endPtr[0] */ const char *endPtr = src + length; /* Pointer to last byte where optimization still can be used */ const char *optPtr = endPtr - 4; /* * Optimize away the call in this loop. Justified because... * when (src <= optPtr), (endPtr - src) >= (endPtr - optPtr) * By initialization above (endPtr - optPtr) = TCL_UTF_MAX * So (endPtr - src) >= TCL_UTF_MAX, and passing that to * Tcl_UtfCharComplete we know will cause return of 1. |
︙ | ︙ | |||
967 968 969 970 971 972 973 974 975 976 977 978 979 980 | Tcl_UtfNext( const char *src) /* The current location in the string. */ { size_t left; const char *next; if (((*src) & 0xC0) == 0x80) { if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) { ++src; } return src; } left = totalBytes[UCHAR(*src)]; | > > > > | 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 | Tcl_UtfNext( const char *src) /* The current location in the string. */ { size_t left; const char *next; if (((*src) & 0xC0) == 0x80) { /* Continuation byte, so we start 'inside' a (possible valid) UTF-8 * sequence. Since we are not allowed to access src[-1], we cannot * check if the sequence is actually valid, the best we can do is * just assume it is valid and locate the end. */ if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) { ++src; } return src; } left = totalBytes[UCHAR(*src)]; |
︙ | ︙ | |||
1061 1062 1063 1064 1065 1066 1067 | /* * We've seen no trailing context to use to check * anything. From what we know, this non-trail byte * is a prefix of a previous character, and accepting * it (the fallback) is correct. */ | | | 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 | /* * We've seen no trailing context to use to check * anything. From what we know, this non-trail byte * is a prefix of a previous character, and accepting * it (the fallback) is correct. */ || (trailBytesSeen >= totalBytes[byte])) { /* * That is, (1 + trailBytesSeen > needed). * We've examined more bytes than needed to complete * this lead byte. No matter about well-formedness or * validity, the sequence starting with this lead byte * will never include the fallback location, so we must * return the fallback location. See test utf-7.17 |
︙ | ︙ | |||
1102 1103 1104 1105 1106 1107 1108 | * and exit this loop before we run past the start of the string. */ return fallback; } /* Continue the search backwards... */ look--; | | | | < < < < < | 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 | * and exit this loop before we run past the start of the string. */ return fallback; } /* Continue the search backwards... */ look--; } while (trailBytesSeen < 4); /* * We've seen 4 trail bytes, so we know there will not be a * properly formed byte sequence to find, and we can stop looking, * accepting the fallback. */ return fallback; } /* *--------------------------------------------------------------------------- * * Tcl_UniCharAtIndex -- * |
︙ | ︙ | |||
1747 1748 1749 1750 1751 1752 1753 | if ((mode & 0x02) && (mode != 0x7)) { ch += GetDelta(info); } } /* Clear away extension bits, if any */ return ch & 0x1FFFFF; } | | | 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 | if ((mode & 0x02) && (mode != 0x7)) { ch += GetDelta(info); } } /* Clear away extension bits, if any */ return ch & 0x1FFFFF; } /* *---------------------------------------------------------------------- * * Tcl_UniCharToTitle -- * * Compute the titlecase equivalent of the given Unicode character. * |
︙ | ︙ | |||
1841 1842 1843 1844 1845 1846 1847 | int TclUniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ size_t numChars) /* Number of unichars to compare. */ { | | > > > > > > > > | 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 | int TclUniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ size_t numChars) /* Number of unichars to compare. */ { #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3) /* * We are definitely on a big-endian machine; memcmp() is safe */ return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar)); #else /* !WORDS_BIGENDIAN */ /* * We can't simply call memcmp() because that is not lexically correct. */ for ( ; numChars != 0; ucs++, uct++, numChars--) { if (*ucs != *uct) { #if TCL_UTF_MAX < 4 /* special case for handling upper surrogates */ if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) { return 1; } else if (((*uct & 0xFC00) == 0xD800)) { return -1; } #endif return (*ucs - *uct); } } return 0; #endif /* WORDS_BIGENDIAN */ } |
︙ | ︙ | |||
1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 | { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); Tcl_UniChar lct = Tcl_UniCharToLower(*uct); if (lcs != lct) { return (lcs - lct); } } } return 0; } | > > > > > > > > | 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 | { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); Tcl_UniChar lct = Tcl_UniCharToLower(*uct); if (lcs != lct) { #if TCL_UTF_MAX < 4 /* special case for handling upper surrogates */ if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) { return 1; } else if (((lct & 0xFC00) == 0xD800)) { return -1; } #endif return (lcs - lct); } } } return 0; } |
︙ | ︙ | |||
2632 2633 2634 2635 2636 2637 2638 | int TclUniCharToUCS4( const Tcl_UniChar *src, /* The Tcl_UniChar string. */ int *ucs4Ptr) /* Filled with the UCS4 codepoint represented * by the Tcl_UniChar string. */ { if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) { | | > > > > > > > > > > > > > | 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 | int TclUniCharToUCS4( const Tcl_UniChar *src, /* The Tcl_UniChar string. */ int *ucs4Ptr) /* Filled with the UCS4 codepoint represented * by the Tcl_UniChar string. */ { if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) { *ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[1] & 0x3FF)) + 0x10000; return 2; } *ucs4Ptr = src[0]; return 1; } const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *src, const Tcl_UniChar *ptr) { if (src <= ptr + 1) { return ptr; } if (((src[-1] & 0xFC00) == 0xDC00) && ((src[-2] & 0xFC00) == 0xD800)) { return src - 2; } return src - 1; } #endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclUtil.c.
1 2 3 4 5 6 | /* * tclUtil.c -- * * This file contains utility functions that are used by many Tcl * commands. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclUtil.c -- * * This file contains utility functions that are used by many Tcl * commands. * * Copyright © 1987-1993 The Regents of the University of California. * Copyright © 1994-1998 Sun Microsystems, Inc. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclParse.h" |
︙ | ︙ | |||
1649 1650 1651 1652 1653 1654 1655 | /* * Outer loop: iterate over string to be trimmed. */ do { const char *q = trim; | | | | | | | 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 | /* * Outer loop: iterate over string to be trimmed. */ do { const char *q = trim; size_t pInc = 0, bytesLeft = numTrim; pp = Tcl_UtfPrev(p, bytes); do { pp += pInc; pInc = TclUtfToUCS4(pp, &ch1); } while (pp + pInc < p); /* * Inner loop: scan trim string for match to current character. */ do { pInc = TclUtfToUCS4(q, &ch2); if (ch1 == ch2) { break; } q += pInc; bytesLeft -= pInc; } while (bytesLeft); if (bytesLeft == 0) { /* * No match; trim task done; *p is last non-trimmed char. */ |
︙ | ︙ | |||
1715 1716 1717 1718 1719 1720 1721 | * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ size_t numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { const char *p = bytes; | | | 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 | * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ size_t numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { const char *p = bytes; int ch1, ch2; /* Empty strings -> nothing to do */ if ((numBytes == 0) || (numTrim == 0)) { return 0; } /* |
︙ | ︙ | |||
1952 1953 1954 1955 1956 1957 1958 | for (i = 0; i < objc; i++) { size_t length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { continue; } | | > > > > > > > | | 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 | for (i = 0; i < objc; i++) { size_t length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { continue; } (void)Tcl_GetStringFromObj(objPtr, &length); if (length > 0) { break; } } if (i == objc) { resPtr = NULL; for (i = 0; i < objc; i++) { objPtr = objv[i]; if (!TclListObjIsCanonical(objPtr)) { 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); } |
︙ | ︙ | |||
1989 1990 1991 1992 1993 1994 1995 | * Something cannot be determined to be safe, so build the concatenation * the slow way, using the string representations. * * First try to pre-allocate the size required. */ for (i = 0; i < objc; i++) { | | | | 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 | * Something cannot be determined to be safe, so build the concatenation * the slow way, using the string representations. * * First try to pre-allocate the size required. */ for (i = 0; i < objc; i++) { element = Tcl_GetStringFromObj(objv[i], &elemLength); bytesNeeded += elemLength; } /* * Does not matter if this fails, will simply try later to build up the * string with each Append reallocating as needed with the usual string * append algorithm. When that fails it will report the error. */ TclNewObj(resPtr); (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1); Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { size_t triml, trimr; element = Tcl_GetStringFromObj(objv[i], &elemLength); /* Trim away the leading/trailing whitespace. */ triml = TclTrim(element, elemLength, CONCAT_TRIM_SET, CONCAT_WS_SIZE, &trimr); element += triml; elemLength -= triml + trimr; |
︙ | ︙ | |||
2489 2490 2491 2492 2493 2494 2495 | * XXX: TclReToGlob tells us about trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj)); */ if (TclHasIntRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) { Tcl_UniChar *udata, *uptn; | | | | | | 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 | * XXX: TclReToGlob tells us about trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj)); */ if (TclHasIntRep(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) { unsigned char *data, *ptn; data = Tcl_GetByteArrayFromObj(strObj, &length); ptn = Tcl_GetByteArrayFromObj(ptnObj, &plen); match = TclByteArrayMatch(data, length, ptn, plen, 0); } else { match = Tcl_StringCaseMatch(TclGetString(strObj), TclGetString(ptnObj), flags); } return match; } |
︙ | ︙ | |||
2625 2626 2627 2628 2629 2630 2631 | char * TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { size_t length; | | | 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 | char * TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { size_t length; const char *bytes = Tcl_GetStringFromObj(objPtr, &length); return Tcl_DStringAppend(dsPtr, bytes, length); } char * TclDStringAppendDString( Tcl_DString *dsPtr, |
︙ | ︙ | |||
3448 3449 3450 3451 3452 3453 3454 | Tcl_ObjIntRep *irPtr; Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */ ClientData cd; while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) { Tcl_ObjIntRep ir; size_t length; | | | 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 | Tcl_ObjIntRep *irPtr; Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */ ClientData cd; while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) { Tcl_ObjIntRep ir; size_t length; const char *bytes = Tcl_GetStringFromObj(objPtr, &length); if (*bytes != 'e') { int numType; const char *opPtr; int len, t1 = 0, t2 = 0; /* Value doesn't start with "e" */ |
︙ | ︙ |
Changes to generic/tclVar.c.
1 2 3 4 5 6 7 8 9 | /* * tclVar.c -- * * This file contains routines that implement Tcl variables (both scalars * and arrays). * * The implementation of arrays is modelled after an initial * implementation by Mark Diekhans and Karl Lehenbauer. * | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | /* * tclVar.c -- * * This file contains routines that implement Tcl variables (both scalars * and arrays). * * The implementation of arrays is modelled after an initial * implementation by Mark Diekhans and Karl Lehenbauer. * * Copyright © 1987-1994 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * Copyright © 2001 Kevin B. Kenny. All rights reserved. * Copyright © 2007 Miguel Sofer * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclOOInt.h" |
︙ | ︙ | |||
661 662 663 664 665 666 667 | if (!parsed) { /* * part1Ptr is possibly an unparsed array element. */ size_t len; | | | 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 | if (!parsed) { /* * part1Ptr is possibly an unparsed array element. */ size_t len; const char *part1 = Tcl_GetStringFromObj(part1Ptr, &len); if ((len > 1) && (part1[len - 1] == ')')) { const char *part2 = strchr(part1, '('); if (part2) { if (part2Ptr != NULL) { if (flags & TCL_LEAVE_ERR_MSG) { |
︙ | ︙ | |||
844 845 846 847 848 849 850 | Tcl_Var var; /* Used to search for global names. */ Var *varPtr; /* Points to the Var structure returned for * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; int isNew, i, result; size_t varLen; | | | 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 | Tcl_Var var; /* Used to search for global names. */ Var *varPtr; /* Points to the Var structure returned for * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; int isNew, i, result; size_t varLen; const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen); varPtr = NULL; varNsPtr = NULL; /* Set non-NULL if a nonlocal variable. */ *indexPtr = -3; if (flags & TCL_GLOBAL_ONLY) { cxtNsPtr = iPtr->globalNsPtr; |
︙ | ︙ | |||
979 980 981 982 983 984 985 | const char *localNameStr; size_t localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { Tcl_Obj *objPtr = *objPtrPtr; if (objPtr) { | | | 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 | const char *localNameStr; size_t localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { Tcl_Obj *objPtr = *objPtrPtr; if (objPtr) { localNameStr = Tcl_GetStringFromObj(objPtr, &localLen); if ((varLen == localLen) && (varName[0] == localNameStr[0]) && !memcmp(varName, localNameStr, varLen)) { *indexPtr = i; return (Var *) &varFramePtr->compiledLocals[i]; } } |
︙ | ︙ |
Changes to generic/tclZipfs.c.
1 2 3 4 | /* * tclZipfs.c -- * * Implementation of the ZIP filesystem used in TIP 430 | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclZipfs.c -- * * Implementation of the ZIP filesystem used in TIP 430 * Adapted from the implementation for AndroWish. * * Copyright © 2016-2017 Sean Woods <[email protected]> * Copyright © 2013-2015 Christian Werner <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * This file is distributed in two ways: * generic/tclZipfs.c file in the TIP430-enabled Tcl cores. * compat/tclZipfs.c file in the tclconfig (TEA) file system, for pre-tip430 |
︙ | ︙ | |||
34 35 36 37 38 39 40 | #ifdef HAVE_ZLIB #include "zlib.h" #include "crypt.h" #include "zutil.h" #include "crc32.h" | < < < < < < < < < < < < < | < < < < | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | #ifdef HAVE_ZLIB #include "zlib.h" #include "crypt.h" #include "zutil.h" #include "crc32.h" /* ** We are compiling as part of the core. ** TIP430 style zipfs prefix */ #define ZIPFS_VOLUME "//zipfs:/" #define ZIPFS_VOLUME_LEN 9 #define ZIPFS_APP_MOUNT "//zipfs:/app" #define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl" #define ZIPFS_FALLBACK_ENCODING "cp437" /* * Various constants and offsets found in ZIP archive files */ #define ZIP_SIG_LEN 4 |
︙ | ︙ | |||
142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | */ #define ZIPFS_ERROR(interp,errstr) \ do { \ if (interp) { \ Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \ } \ } while (0) #define ZIPFS_POSIX_ERROR(interp,errstr) \ do { \ if (interp) { \ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \ "%s: %s", errstr, Tcl_PosixError(interp))); \ } \ } while (0) | > > > > > > > > | < < < < < < < < < < | < < < < | < > | < < > > > > > > | 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 | */ #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) /* * Windows drive letters. */ #ifdef _WIN32 static const char drvletters[] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; #endif /* _WIN32 */ /* * Mutex to protect localtime(3) when no reentrant version available. */ #if !defined(_WIN32) && !defined(HAVE_LOCALTIME_R) && TCL_THREADS TCL_DECLARE_MUTEX(localtimeMutex) #endif /* !_WIN32 && !HAVE_LOCALTIME_R && TCL_THREADS */ /* * Forward declaration. */ struct ZipEntry; /* * In-core description of mounted ZIP archive file. */ typedef struct ZipFile { char *name; /* Archive name */ size_t nameLength; /* Length of archive name */ |
︙ | ︙ | |||
219 220 221 222 223 224 225 226 227 228 229 230 | #ifdef _WIN32 HANDLE mountHandle; /* Handle used for direct file access. */ #endif /* _WIN32 */ } ZipFile; /* * In-core description of file contained in mounted ZIP archive. */ typedef struct ZipEntry { char *name; /* The full pathname of the virtual file */ ZipFile *zipFilePtr; /* The ZIP file holding this virtual file */ | > | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 | #ifdef _WIN32 HANDLE mountHandle; /* Handle used for direct file access. */ #endif /* _WIN32 */ } ZipFile; /* * In-core description of file contained in mounted ZIP archive. * ZIP_ATTR_ */ typedef struct ZipEntry { char *name; /* The full pathname of the virtual file */ ZipFile *zipFilePtr; /* The ZIP file holding this virtual file */ size_t offset; /* Data offset into memory mapped ZIP file */ int numBytes; /* Uncompressed size of the virtual file */ int numCompressedBytes; /* Compressed size of the virtual file */ int compressMethod; /* Compress method */ int isDirectory; /* Set to 1 if directory, or -1 if root */ int depth; /* Number of slashes in path. */ int crc32; /* CRC-32 */ int timestamp; /* Modification time */ |
︙ | ︙ | |||
274 275 276 277 278 279 280 | * ZIP archive files. */ static struct { int initialized; /* True when initialized */ int lock; /* RW lock, see below */ int waiters; /* RW lock, see below */ | | > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > | 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 | * ZIP archive files. */ static struct { int initialized; /* True when initialized */ int lock; /* RW lock, see below */ int waiters; /* RW lock, see below */ int wrmax; /* Maximum write size of a file; only written * to from Tcl code in a trusted interpreter, * so NOT protected by mutex. */ char *fallbackEntryEncoding;/* The fallback encoding for ZIP entries when * they are believed to not be UTF-8; only * written to from Tcl code in a trusted * interpreter, so not protected by mutex. */ Tcl_Encoding utf8; /* The UTF-8 encoding that we prefer to use * for the strings (especially filenames) * embedded in a ZIP. Other encodings are used * dynamically. */ int idCount; /* Counter for channel names */ Tcl_HashTable fileHash; /* File name to ZipEntry mapping */ Tcl_HashTable zipHash; /* Mount to ZipFile mapping */ } ZipFS = { 0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, NULL, 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} }; /* * For password rotation. */ static const char pwrot[17] = "\x00\x80\x40\xC0\x20\xA0\x60\xE0" "\x10\x90\x50\xD0\x30\xB0\x70\xF0"; static const char *zipfs_literal_tcl_library = NULL; /* Function prototypes */ static int CopyImageFile(Tcl_Interp *interp, const char *imgName, Tcl_Channel out); static inline int DescribeMounted(Tcl_Interp *interp, const char *mountPoint); static int InitReadableChannel(Tcl_Interp *interp, ZipChannel *info, ZipEntry *z); static int InitWritableChannel(Tcl_Interp *interp, ZipChannel *info, ZipEntry *z, int trunc); static 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, long long dataStartOffset); static void SerializeCentralDirectorySuffix( const unsigned char *start, const unsigned char *end, unsigned char *buf, int entryCount, long long dataStartOffset, 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); #endif static int ZipFSPathInFilesystemProc(Tcl_Obj *pathPtr, void **clientDataPtr); static Tcl_Obj * ZipFSFilesystemPathTypeProc(Tcl_Obj *pathPtr); static Tcl_Obj * ZipFSFilesystemSeparatorProc(Tcl_Obj *pathPtr); static int ZipFSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); static int ZipFSAccessProc(Tcl_Obj *pathPtr, int mode); static Tcl_Channel ZipFSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); static int ZipFSMatchInDirectoryProc(Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); static void ZipFSMatchMountPoints(Tcl_Obj *result, Tcl_Obj *normPathPtr, const char *pattern, Tcl_DString *prefix); static Tcl_Obj * ZipFSListVolumesProc(void); static const char *const *ZipFSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); static int ZipFSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); static int ZipFSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); static int ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); static int ZipMapArchive(Tcl_Interp *interp, ZipFile *zf, void *handle); static void 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, int mode, int *errloc); #endif static long long ZipChannelWideSeek(void *instanceData, long long offset, int mode, int *errloc); static void ZipChannelWatchChannel(void *instanceData, int mask); static int ZipChannelWrite(void *instanceData, const char *buf, int toWrite, int *errloc); /* * Define the ZIP filesystem dispatch table. |
︙ | ︙ | |||
368 369 370 371 372 373 374 | NULL, /* createDirectoryProc */ NULL, /* removeDirectoryProc */ NULL, /* deleteFileProc */ NULL, /* copyFileProc */ NULL, /* renameFileProc */ NULL, /* copyDirectoryProc */ NULL, /* lstatProc */ | | | | | | > > > | > | | | | | | > | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | NULL, /* createDirectoryProc */ NULL, /* removeDirectoryProc */ NULL, /* deleteFileProc */ NULL, /* copyFileProc */ NULL, /* renameFileProc */ NULL, /* copyDirectoryProc */ NULL, /* lstatProc */ (Tcl_FSLoadFileProc *) (void *) ZipFSLoadFile, NULL, /* getCwdProc */ NULL, /* chdirProc */ }; /* * The channel type/driver definition used for ZIP archive members. */ static Tcl_ChannelType ZipChannelType = { "zip", /* Type name. */ TCL_CHANNEL_VERSION_5, TCL_CLOSE2PROC, /* Close channel, clean instance data */ ZipChannelRead, /* Handle read request */ ZipChannelWrite, /* Handle write request */ #if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) ZipChannelSeek, /* Move location of access point, NULL'able */ #else NULL, /* Move location of access point, NULL'able */ #endif NULL, /* Set options, NULL'able */ NULL, /* Get options, NULL'able */ ZipChannelWatchChannel, /* Initialize notifier */ ZipChannelGetFile, /* Get OS handle from the channel */ ZipChannelClose, /* 2nd version of close channel, NULL'able */ NULL, /* Set blocking mode for raw channel, * NULL'able */ NULL, /* Function to flush channel, NULL'able */ NULL, /* Function to handle event, NULL'able */ ZipChannelWideSeek, /* Wide seek function, NULL'able */ NULL, /* Thread action function, NULL'able */ NULL, /* Truncate function, NULL'able */ }; /* * Miscellaneous constants. */ #define ERROR_LENGTH ((size_t) -1) /* *------------------------------------------------------------------------- * * ZipReadInt, ZipReadShort, ZipWriteInt, ZipWriteShort -- * * Inline functions to read and write little-endian 16 and 32 bit * integers from/to buffers representing parts of ZIP archives. * * These take bufferStart and bufferEnd pointers, which are used to * maintain a guarantee that out-of-bounds accesses don't happen when * reading or writing critical directory structures. * *------------------------------------------------------------------------- */ static inline unsigned int ZipReadInt( const unsigned char *bufferStart, const unsigned char *bufferEnd, const unsigned char *ptr) { if (ptr < bufferStart || ptr + 4 > bufferEnd) { Tcl_Panic("out of bounds read(4): start=%p, end=%p, ptr=%p", bufferStart, bufferEnd, ptr); } return ptr[0] | (ptr[1] << 8) | (ptr[2] << 16) | (ptr[3] << 24); } static inline unsigned short ZipReadShort( const unsigned char *bufferStart, const unsigned char *bufferEnd, const unsigned char *ptr) { if (ptr < bufferStart || ptr + 2 > bufferEnd) { Tcl_Panic("out of bounds read(2): start=%p, end=%p, ptr=%p", bufferStart, bufferEnd, ptr); } return ptr[0] | (ptr[1] << 8); } static inline void ZipWriteInt( const unsigned char *bufferStart, const unsigned char *bufferEnd, unsigned char *ptr, unsigned int value) { if (ptr < bufferStart || ptr + 4 > bufferEnd) { Tcl_Panic("out of bounds write(4): start=%p, end=%p, ptr=%p", bufferStart, bufferEnd, ptr); } ptr[0] = value & 0xff; ptr[1] = (value >> 8) & 0xff; ptr[2] = (value >> 16) & 0xff; ptr[3] = (value >> 24) & 0xff; } static inline void ZipWriteShort( const unsigned char *bufferStart, const unsigned char *bufferEnd, unsigned char *ptr, unsigned short value) { if (ptr < bufferStart || ptr + 2 > bufferEnd) { Tcl_Panic("out of bounds write(2): start=%p, end=%p, ptr=%p", bufferStart, bufferEnd, ptr); } ptr[0] = value & 0xff; ptr[1] = (value >> 8) & 0xff; } /* *------------------------------------------------------------------------- * * ReadLock, WriteLock, Unlock -- * * POSIX like rwlock functions to support multiple readers and single |
︙ | ︙ | |||
418 419 420 421 422 423 424 | TCL_DECLARE_MUTEX(ZipFSMutex) #if TCL_THREADS static Tcl_Condition ZipFSCond; | | | | | 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 | TCL_DECLARE_MUTEX(ZipFSMutex) #if TCL_THREADS static Tcl_Condition ZipFSCond; static inline void ReadLock(void) { Tcl_MutexLock(&ZipFSMutex); while (ZipFS.lock < 0) { ZipFS.waiters++; Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); ZipFS.waiters--; } ZipFS.lock++; Tcl_MutexUnlock(&ZipFSMutex); } static inline void WriteLock(void) { Tcl_MutexLock(&ZipFSMutex); while (ZipFS.lock != 0) { ZipFS.waiters++; Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); ZipFS.waiters--; } ZipFS.lock = -1; Tcl_MutexUnlock(&ZipFSMutex); } static inline void Unlock(void) { Tcl_MutexLock(&ZipFSMutex); if (ZipFS.lock > 0) { --ZipFS.lock; } else if (ZipFS.lock < 0) { ZipFS.lock = 0; |
︙ | ︙ | |||
564 565 566 567 568 569 570 | * * Side effects: * None. * *------------------------------------------------------------------------- */ | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | * * Side effects: * None. * *------------------------------------------------------------------------- */ static inline int CountSlashes( const char *string) { int count = 0; const char *p = string; while (*p != '\0') { if (*p == '/') { count++; } p++; } return count; } /* *------------------------------------------------------------------------- * * DecodeZipEntryText -- * * Given a sequence of bytes from an entry in a ZIP central directory, * convert that into a Tcl string. This is complicated because we don't * actually know what encoding is in use! So we try to use UTF-8, and if * that goes wrong, we fall back to a user-specified encoding, or to an * encoding we specify (Windows code page 437), or to ISO 8859-1 if * absolutely nothing else works. * * During Tcl startup, we skip the user-specified encoding and cp437, as * we may well not have any loadable encodings yet. Tcl's own library * files ought to be using ASCII filenames. * * Results: * The decoded filename; the filename is owned by the argument DString. * * Side effects: * Updates dstPtr. * *------------------------------------------------------------------------- */ static char * DecodeZipEntryText( const unsigned char *inputBytes, unsigned int inputLength, Tcl_DString *dstPtr) { Tcl_Encoding encoding; const char *src; char *dst; int dstLen, srcLen = inputLength, flags; Tcl_EncodingState state; Tcl_DStringInit(dstPtr); if (inputLength < 1) { return Tcl_DStringValue(dstPtr); } /* * We can't use Tcl_ExternalToUtfDString at this point; it has no way to * fail. So we use this modified version of it that can report encoding * errors to us (so we can fall back to something else). * * The utf-8 encoding is implemented internally, and so is guaranteed to * be present. */ src = (const char *) inputBytes; dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; flags = TCL_ENCODING_START | TCL_ENCODING_END | TCL_ENCODING_STOPONERROR; /* Special flag! */ while (1) { int srcRead, dstWrote; int result = Tcl_ExternalToUtf(NULL, ZipFS.utf8, src, srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote, NULL); int soFar = dst + dstWrote - Tcl_DStringValue(dstPtr); if (result == TCL_OK) { Tcl_DStringSetLength(dstPtr, soFar); return Tcl_DStringValue(dstPtr); } else if (result != TCL_CONVERT_NOSPACE) { break; } flags &= ~TCL_ENCODING_START; src += srcRead; 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; } /* * Something went wrong. Fall back to another encoding. Those *can* use * Tcl_ExternalToUtfDString(). */ encoding = NULL; if (ZipFS.fallbackEntryEncoding) { encoding = Tcl_GetEncoding(NULL, ZipFS.fallbackEntryEncoding); } if (!encoding) { encoding = Tcl_GetEncoding(NULL, ZIPFS_FALLBACK_ENCODING); } if (!encoding) { /* * Fallback to internal encoding that always converts all bytes. * Should only happen when a filename isn't UTF-8 and we've not got * our encodings initialised for some reason. */ encoding = Tcl_GetEncoding(NULL, "iso8859-1"); } char *converted = Tcl_ExternalToUtfDString(encoding, (const char *) inputBytes, inputLength, dstPtr); Tcl_FreeEncoding(encoding); return converted; } /* *------------------------------------------------------------------------- * * CanonicalPath -- * * This function computes the canonical path from a directory and file |
︙ | ︙ | |||
768 769 770 771 772 773 774 | * * Side effects: * None. * *------------------------------------------------------------------------- */ | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < < < < < < < < < < < < < < < < < < | | | < < | < < < | < > | > | < | 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 | * * Side effects: * None. * *------------------------------------------------------------------------- */ static inline ZipEntry * ZipFSLookup( const char *filename) { Tcl_HashEntry *hPtr; ZipEntry *z = NULL; hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename); if (hPtr) { z = (ZipEntry *) Tcl_GetHashValue(hPtr); } return z; } /* *------------------------------------------------------------------------- * * ZipFSLookupZip -- * * This function gets the structure for a mounted ZIP archive. * * Results: * Returns a pointer to the structure, or NULL if the file is ZIP file is * unknown/not mounted. * * Side effects: * None. * *------------------------------------------------------------------------- */ static inline ZipFile * ZipFSLookupZip( const char *mountPoint) { Tcl_HashEntry *hPtr; ZipFile *zf = NULL; hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint); if (hPtr) { zf = (ZipFile *) Tcl_GetHashValue(hPtr); } return zf; } /* *------------------------------------------------------------------------- * * AllocateZipFile, AllocateZipEntry, AllocateZipChannel -- * * Allocates the memory for a datastructure. Always ensures that it is * zeroed out for safety. * * Returns: * The allocated structure, or NULL if allocate fails. * * Side effects: * The interpreter result may be written to on error. Which might fail * (for ZipFile) in a low-memory situation. Always panics if ZipEntry * allocation fails. * *------------------------------------------------------------------------- */ static inline ZipFile * AllocateZipFile( Tcl_Interp *interp, size_t mountPointNameLength) { size_t size = sizeof(ZipFile) + mountPointNameLength + 1; ZipFile *zf = (ZipFile *) Tcl_AttemptAlloc(size); if (!zf) { ZIPFS_MEM_ERROR(interp); } else { memset(zf, 0, size); } return zf; } static inline ZipEntry * AllocateZipEntry(void) { ZipEntry *z = (ZipEntry *) Tcl_Alloc(sizeof(ZipEntry)); memset(z, 0, sizeof(ZipEntry)); return z; } static inline ZipChannel * AllocateZipChannel( Tcl_Interp *interp) { ZipChannel *zc = (ZipChannel *) Tcl_AttemptAlloc(sizeof(ZipChannel)); if (!zc) { ZIPFS_MEM_ERROR(interp); } else { memset(zc, 0, sizeof(ZipChannel)); } return zc; } /* *------------------------------------------------------------------------- * * ZipFSCloseArchive -- * * This function closes a mounted ZIP archive file. |
︙ | ︙ | |||
854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 | Tcl_Free(zf->ptrToFree); zf->ptrToFree = NULL; } zf->data = NULL; return; } #ifdef _WIN32 if (zf->data && !zf->ptrToFree) { UnmapViewOfFile(zf->data); zf->data = NULL; } if (zf->mountHandle != INVALID_HANDLE_VALUE) { CloseHandle(zf->mountHandle); } #else /* !_WIN32 */ if ((zf->data != MAP_FAILED) && !zf->ptrToFree) { munmap(zf->data, zf->length); | > > > > | | | | > > > > > > > > | | > > > > > | | | | > > > | | | | | | > > > | | | | | | | | > > > | | | < < | | < < | | | > > > > > > | > > > | > | | 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 | Tcl_Free(zf->ptrToFree); zf->ptrToFree = NULL; } zf->data = NULL; return; } /* * Remove the memory mapping, if we have one. */ #ifdef _WIN32 if (zf->data && !zf->ptrToFree) { UnmapViewOfFile(zf->data); zf->data = NULL; } if (zf->mountHandle != INVALID_HANDLE_VALUE) { CloseHandle(zf->mountHandle); } #else /* !_WIN32 */ if ((zf->data != MAP_FAILED) && !zf->ptrToFree) { munmap(zf->data, zf->length); zf->data = (unsigned char *) MAP_FAILED; } #endif /* _WIN32 */ if (zf->ptrToFree) { Tcl_Free(zf->ptrToFree); zf->ptrToFree = NULL; } if (zf->chan) { Tcl_Close(interp, zf->chan); zf->chan = NULL; } } /* *------------------------------------------------------------------------- * * ZipFSFindTOC -- * * This function takes a memory mapped zip file and indexes the contents. * When "needZip" is zero an embedded ZIP archive in an executable file * is accepted. Note that we do not support ZIP64. * * Results: * TCL_OK on success, TCL_ERROR otherwise with an error message placed * into the given "interp" if it is not NULL. * * Side effects: * The given ZipFile struct is filled with information about the ZIP * archive file. * *------------------------------------------------------------------------- */ static int ZipFSFindTOC( Tcl_Interp *interp, /* Current interpreter. NULLable. */ int needZip, ZipFile *zf) { size_t i; 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 * on the end of executables; digital signatures can also go there. */ p = zf->data + zf->length - ZIP_CENTRAL_END_LEN; while (p >= start) { if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) { if (ZipReadInt(start, end, p) == ZIP_CENTRAL_END_SIG) { break; } p -= ZIP_SIG_LEN; } else { --p; } } if (p < zf->data) { /* * Didn't find it (or not enough space for a central directory!); not * a ZIP archive. This might be OK or a problem. */ if (!needZip) { zf->baseOffset = zf->passOffset = zf->length; return TCL_OK; } ZIPFS_ERROR(interp, "wrong end signature"); ZIPFS_ERROR_CODE(interp, "END_SIG"); goto error; } /* * How many files in the archive? If that's bogus, we're done here. */ zf->numFiles = ZipReadShort(start, end, p + ZIP_CENTRAL_ENTS_OFFS); if (zf->numFiles == 0) { if (!needZip) { zf->baseOffset = zf->passOffset = zf->length; return TCL_OK; } ZIPFS_ERROR(interp, "empty archive"); ZIPFS_ERROR_CODE(interp, "EMPTY"); goto error; } /* * 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. */ zf->baseOffset = zf->passOffset = p - q; zf->directoryOffset = p - zf->data; q = p; for (i = 0; i < zf->numFiles; i++) { int pathlen, comlen, extra; 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); q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; } /* * If there's also an encoded password, extract that too (but don't decode * yet). */ q = zf->data + zf->baseOffset; if ((zf->baseOffset >= 6) && (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); |
︙ | ︙ | |||
1035 1036 1037 1038 1039 1040 1041 | zf->nameLength = 0; zf->isMemBuffer = 0; #ifdef _WIN32 zf->data = NULL; zf->mountHandle = INVALID_HANDLE_VALUE; #else /* !_WIN32 */ | | > > > > > > > > > > > > > > > | > > > > > > > > > | | < < | < | < < | < < < < < < < < < < < < < | < < < | < | < < < < < < | < < < | < | < < < < < < | | < < > > > > > > > | > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > < > | | < < | < < < > > > > > > > > > > > > > | | | | < < < | < < < < < < > > > | | > | | < < | < < < < < < | > > | | | < | < | | | | | | | | > | < > | < < | > | | | | > | > | | | | > | > < > > | | | | | | | | | > > > > > > | | | | | | | | | | | | > > > | | | | < | | | < | < | < | < | | | | | | | < | 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 | zf->nameLength = 0; zf->isMemBuffer = 0; #ifdef _WIN32 zf->data = NULL; zf->mountHandle = INVALID_HANDLE_VALUE; #else /* !_WIN32 */ zf->data = (unsigned char *) MAP_FAILED; #endif /* _WIN32 */ zf->length = 0; zf->numFiles = 0; zf->baseOffset = zf->passOffset = 0; zf->ptrToFree = NULL; zf->passBuf[0] = 0; /* * Actually open the file. */ zf->chan = Tcl_OpenFileChannel(interp, zipname, "rb", 0); if (!zf->chan) { return TCL_ERROR; } /* * See if we can get the OS handle. If we can, we can use that to memory * map the file, which is nice and efficient. However, it totally depends * on the filename pointing to a real regular OS file. * * Opening real filesystem entities that are not files will lead to an * error. */ if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) == TCL_OK) { if (ZipMapArchive(interp, zf, handle) != TCL_OK) { goto error; } } else { /* * Not an OS file, but rather something in a Tcl VFS. Must copy into * memory. */ zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); if (zf->length == ERROR_LENGTH) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } if ((zf->length - ZIP_CENTRAL_END_LEN) > (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) { ZIPFS_ERROR(interp, "illegal file size"); ZIPFS_ERROR_CODE(interp, "FILE_SIZE"); goto error; } if (Tcl_Seek(zf->chan, 0, SEEK_SET) == -1) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } zf->ptrToFree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length); if (!zf->ptrToFree) { ZIPFS_MEM_ERROR(interp); goto error; } i = Tcl_Read(zf->chan, (char *) zf->data, zf->length); if (i != zf->length) { ZIPFS_POSIX_ERROR(interp, "file read error"); goto error; } Tcl_Close(interp, zf->chan); zf->chan = NULL; } return ZipFSFindTOC(interp, needZip, zf); /* * Handle errors by closing the archive. This includes closing the channel * handle for the archive file. */ error: ZipFSCloseArchive(interp, zf); return TCL_ERROR; } /* *------------------------------------------------------------------------- * * ZipMapArchive -- * * Wrapper around the platform-specific parts of mmap() (and Windows's * equivalent) because it's not part of the standard channel API. * *------------------------------------------------------------------------- */ static int ZipMapArchive( Tcl_Interp *interp, /* Interpreter for error reporting. */ ZipFile *zf, /* The archive descriptor structure. */ void *handle) /* The OS handle to the open archive. */ { #ifdef _WIN32 HANDLE hFile = (HANDLE) handle; int readSuccessful; /* * Determine the file size. */ # ifdef _WIN64 readSuccessful = GetFileSizeEx(hFile, (PLARGE_INTEGER) &zf->length) != 0; # else /* !_WIN64 */ zf->length = GetFileSize(hFile, 0); readSuccessful = (zf->length != (size_t) INVALID_FILE_SIZE); # endif /* _WIN64 */ if (!readSuccessful || (zf->length < ZIP_CENTRAL_END_LEN)) { ZIPFS_POSIX_ERROR(interp, "invalid file size"); return TCL_ERROR; } /* * Map the file. */ zf->mountHandle = CreateFileMappingW(hFile, 0, PAGE_READONLY, 0, zf->length, 0); if (zf->mountHandle == INVALID_HANDLE_VALUE) { ZIPFS_POSIX_ERROR(interp, "file mapping failed"); return TCL_ERROR; } zf->data = (unsigned char *) MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0, zf->length); if (!zf->data) { ZIPFS_POSIX_ERROR(interp, "file mapping failed"); return TCL_ERROR; } #else /* !_WIN32 */ int fd = PTR2INT(handle); /* * Determine the file size. */ zf->length = lseek(fd, 0, SEEK_END); if (zf->length == ERROR_LENGTH || zf->length < ZIP_CENTRAL_END_LEN) { ZIPFS_POSIX_ERROR(interp, "invalid file size"); return TCL_ERROR; } lseek(fd, 0, SEEK_SET); zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ, MAP_FILE | MAP_PRIVATE, fd, 0); if (zf->data == MAP_FAILED) { ZIPFS_POSIX_ERROR(interp, "file mapping failed"); return TCL_ERROR; } #endif /* _WIN32 */ return TCL_OK; } /* *------------------------------------------------------------------------- * * IsPasswordValid -- * * Basic test for whether a passowrd is valid. If the test fails, sets an * error message in the interpreter. * * Returns: * TCL_OK if the test passes, TCL_ERROR if it fails. * *------------------------------------------------------------------------- */ static inline int IsPasswordValid( Tcl_Interp *interp, const char *passwd, int pwlen) { if ((pwlen > 255) || strchr(passwd, 0xff)) { ZIPFS_ERROR(interp, "illegal password"); ZIPFS_ERROR_CODE(interp, "BAD_PASS"); return TCL_ERROR; } return TCL_OK; } /* *------------------------------------------------------------------------- * * ZipFSCatalogFilesystem -- * * This function generates the root node for a ZIPFS filesystem by * reading the ZIP's central directory. * * Results: * TCL_OK on success, TCL_ERROR otherwise with an error message placed * into the given "interp" if it is not NULL. * * Side effects: * Will acquire and release the write lock. * *------------------------------------------------------------------------- */ 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. */ pwlen = 0; if (passwd) { pwlen = strlen(passwd); if (IsPasswordValid(interp, passwd, pwlen) != TCL_OK) { return TCL_ERROR; } } /* * 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); Tcl_Free(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); Tcl_Free(zf); return TCL_ERROR; } Unlock(); /* * Convert to a real archive descriptor. */ zf->mountPoint = (char *) Tcl_GetHashKey(&ZipFS.zipHash, hPtr); Tcl_CreateExitHandler(ZipfsExitHandler, zf); zf->mountPointLen = strlen(zf->mountPoint); zf->nameLength = strlen(zipname); zf->name = (char *) Tcl_Alloc(zf->nameLength + 1); memcpy(zf->name, zipname, zf->nameLength + 1); Tcl_SetHashValue(hPtr, zf); if ((zf->passBuf[0] == 0) && pwlen) { int k = 0; zf->passBuf[k++] = pwlen; for (i = pwlen; i-- > 0 ;) { zf->passBuf[k++] = (passwd[i] & 0x0f) | pwrot[(passwd[i] >> 4) & 0x0f]; } zf->passBuf[k] = '\0'; } if (mountPoint[0] != '\0') { hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mountPoint, &isNew); if (isNew) { z = AllocateZipEntry(); Tcl_SetHashValue(hPtr, z); z->depth = CountSlashes(mountPoint); z->zipFilePtr = zf; z->isDirectory = (zf->baseOffset == 0) ? 1 : -1; /* root marker */ z->offset = zf->baseOffset; z->compressMethod = ZIP_COMPMETH_STORED; z->name = (char *) Tcl_GetHashKey(&ZipFS.fileHash, hPtr); z->next = zf->entries; zf->entries = z; } } q = zf->data + zf->directoryOffset; Tcl_DStringInit(&fpBuf); for (i = 0; i < zf->numFiles; i++) { const unsigned char *start = zf->data; const unsigned char *end = zf->data + zf->length; int extra, isdir = 0, dosTime, dosDate, nbcompr; size_t offs, pathlen, comlen; unsigned char *lq, *gq = NULL; char *fullpath, *path; 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); path = DecodeZipEntryText(q + ZIP_CENTRAL_HEADER_LEN, pathlen, &ds); if ((pathlen > 0) && (path[pathlen - 1] == '/')) { Tcl_DStringSetLength(&ds, pathlen - 1); path = Tcl_DStringValue(&ds); isdir = 1; } if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) { goto nextent; } lq = zf->data + zf->baseOffset + ZipReadInt(start, end, q + ZIP_CENTRAL_LOCALHDR_OFFS); if ((lq < start) || (lq + ZIP_LOCAL_HEADER_LEN > end)) { goto nextent; } nbcompr = ZipReadInt(start, end, lq + ZIP_LOCAL_COMPLEN_OFFS); if (!isdir && (nbcompr == 0) && (ZipReadInt(start, end, lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) && (ZipReadInt(start, end, lq + ZIP_LOCAL_CRC32_OFFS) == 0)) { gq = q; nbcompr = ZipReadInt(start, end, gq + ZIP_CENTRAL_COMPLEN_OFFS); } offs = (lq - zf->data) + ZIP_LOCAL_HEADER_LEN + ZipReadShort(start, end, lq + ZIP_LOCAL_PATHLEN_OFFS) + ZipReadShort(start, end, lq + ZIP_LOCAL_EXTRALEN_OFFS); if (offs + nbcompr > zf->length) { goto nextent; } if (!isdir && (mountPoint[0] == '\0') && !CountSlashes(path)) { #ifdef ANDROID /* * When mounting the ZIP archive on the root directory try to * remap top level regular files of the archive to * /assets/.root/... since this directory should not be in a valid * APK due to the leading dot in the file name component. This * trick should make the files AndroidManifest.xml, * resources.arsc, and classes.dex visible to Tcl. */ Tcl_DString ds2; Tcl_DStringInit(&ds2); Tcl_DStringAppend(&ds2, "assets/.root/", -1); Tcl_DStringAppend(&ds2, path, -1); if (ZipFSLookup(Tcl_DStringValue(&ds2))) { /* should not happen but skip it anyway */ Tcl_DStringFree(&ds2); goto nextent; } Tcl_DStringSetLength(&ds, 0); Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2), Tcl_DStringLength(&ds2)); path = Tcl_DStringValue(&ds); Tcl_DStringFree(&ds2); #else /* !ANDROID */ /* * Regular files skipped when mounting on root. */ goto nextent; #endif /* ANDROID */ } Tcl_DStringSetLength(&fpBuf, 0); fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1); z = AllocateZipEntry(); z->depth = CountSlashes(fullpath); z->zipFilePtr = zf; z->isDirectory = isdir; z->isEncrypted = (ZipReadShort(start, end, lq + ZIP_LOCAL_FLAGS_OFFS) & 1) && (nbcompr > 12); z->offset = offs; if (gq) { z->crc32 = ZipReadInt(start, end, gq + ZIP_CENTRAL_CRC32_OFFS); dosDate = ZipReadShort(start, end, gq + ZIP_CENTRAL_MDATE_OFFS); dosTime = ZipReadShort(start, end, gq + ZIP_CENTRAL_MTIME_OFFS); z->timestamp = DosTimeDate(dosDate, dosTime); z->numBytes = ZipReadInt(start, end, gq + ZIP_CENTRAL_UNCOMPLEN_OFFS); z->compressMethod = ZipReadShort(start, end, gq + ZIP_CENTRAL_COMPMETH_OFFS); } else { z->crc32 = ZipReadInt(start, end, lq + ZIP_LOCAL_CRC32_OFFS); dosDate = ZipReadShort(start, end, lq + ZIP_LOCAL_MDATE_OFFS); dosTime = ZipReadShort(start, end, lq + ZIP_LOCAL_MTIME_OFFS); z->timestamp = DosTimeDate(dosDate, dosTime); z->numBytes = ZipReadInt(start, end, lq + ZIP_LOCAL_UNCOMPLEN_OFFS); z->compressMethod = ZipReadShort(start, end, lq + ZIP_LOCAL_COMPMETH_OFFS); } z->numCompressedBytes = nbcompr; hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); if (!isNew) { /* should not happen but skip it anyway */ Tcl_Free(z); goto nextent; } Tcl_SetHashValue(hPtr, z); z->name = (char *) Tcl_GetHashKey(&ZipFS.fileHash, hPtr); z->next = zf->entries; zf->entries = z; if (isdir && (mountPoint[0] == '\0') && (z->depth == 1)) { z->tnext = zf->topEnts; zf->topEnts = z; } /* * Make any directory nodes we need. ZIPs are not consistent about * containing directory nodes. */ if (!z->isDirectory && (z->depth > 1)) { char *dir, *endPtr; ZipEntry *zd; Tcl_DStringSetLength(&ds, strlen(z->name) + 8); Tcl_DStringSetLength(&ds, 0); Tcl_DStringAppend(&ds, z->name, -1); dir = Tcl_DStringValue(&ds); for (endPtr = strrchr(dir, '/'); endPtr && (endPtr != dir); endPtr = strrchr(dir, '/')) { Tcl_DStringSetLength(&ds, endPtr - dir); hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); if (!isNew) { /* * Already made. That's fine. */ break; } zd = AllocateZipEntry(); zd->depth = CountSlashes(dir); zd->zipFilePtr = zf; zd->isDirectory = 1; zd->offset = z->offset; zd->timestamp = z->timestamp; zd->compressMethod = ZIP_COMPMETH_STORED; Tcl_SetHashValue(hPtr, zd); zd->name = (char *) Tcl_GetHashKey(&ZipFS.fileHash, hPtr); zd->next = zf->entries; zf->entries = zd; if ((mountPoint[0] == '\0') && (zd->depth == 1)) { zd->tnext = zf->topEnts; zf->topEnts = zd; } } } nextent: q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; } Tcl_DStringFree(&fpBuf); |
︙ | ︙ | |||
1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 | #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.initialized = 1; } /* *------------------------------------------------------------------------- * * ListMountPoints -- | > > > > | 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 | #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 *) Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1); strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING); ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8"); ZipFS.initialized = 1; } /* *------------------------------------------------------------------------- * * ListMountPoints -- |
︙ | ︙ | |||
1483 1484 1485 1486 1487 1488 1489 1490 | static inline int ListMountPoints( Tcl_Interp *interp) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; ZipFile *zf; | > < < | > > > > | > | > > > > | > | > | > | | 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 | static inline int ListMountPoints( Tcl_Interp *interp) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; ZipFile *zf; Tcl_Obj *resultList; if (!interp) { /* * Are there any entries in the zipHash? Don't need to enumerate them * all to know. */ return (ZipFS.zipHash.numEntries ? TCL_OK : TCL_BREAK); } resultList = Tcl_NewObj(); for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { zf = (ZipFile *) Tcl_GetHashValue(hPtr); Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj( zf->mountPoint, -1)); Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj( zf->name, -1)); } Tcl_SetObjResult(interp, resultList); return TCL_OK; } /* *------------------------------------------------------------------------- * * DescribeMounted -- * |
︙ | ︙ | |||
1520 1521 1522 1523 1524 1525 1526 | */ static inline int DescribeMounted( Tcl_Interp *interp, const char *mountPoint) { | | | < < | < | 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 | */ static inline int DescribeMounted( Tcl_Interp *interp, const char *mountPoint) { if (interp) { ZipFile *zf = ZipFSLookupZip(mountPoint); if (zf) { Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1)); return TCL_OK; } } return (interp ? TCL_OK : TCL_BREAK); } |
︙ | ︙ | |||
1556 1557 1558 1559 1560 1561 1562 | *------------------------------------------------------------------------- */ int TclZipfs_Mount( Tcl_Interp *interp, /* Current interpreter. NULLable. */ const char *mountPoint, /* Mount point path. */ | | > | 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 | *------------------------------------------------------------------------- */ int TclZipfs_Mount( Tcl_Interp *interp, /* Current interpreter. NULLable. */ const char *mountPoint, /* Mount point path. */ const char *zipname, /* Path to ZIP file to mount; should be * normalized. */ const char *passwd) /* Password for opening the ZIP, or NULL if * the ZIP is unprotected. */ { ZipFile *zf; ReadLock(); if (!ZipFS.initialized) { |
︙ | ︙ | |||
1593 1594 1595 1596 1597 1598 1599 | } Unlock(); /* * Have both a mount point and a file (name) to mount there. */ | | < < < < < < | | < | < < < < < < | 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 | } Unlock(); /* * Have both a mount point and a file (name) to mount there. */ if (passwd && IsPasswordValid(interp, passwd, strlen(passwd)) != TCL_OK) { return TCL_ERROR; } zf = AllocateZipFile(interp, strlen(mountPoint)); if (!zf) { return TCL_ERROR; } if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) { Tcl_Free(zf); return TCL_ERROR; } if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } /* *------------------------------------------------------------------------- * * TclZipfs_MountBuffer -- |
︙ | ︙ | |||
1684 1685 1686 1687 1688 1689 1690 | } Unlock(); /* * Have both a mount point and data to mount there. */ | | < < < < | | < < < < < | 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 | } Unlock(); /* * Have both a mount point and data to mount there. */ zf = AllocateZipFile(interp, strlen(mountPoint)); if (!zf) { return TCL_ERROR; } zf->isMemBuffer = 1; zf->length = datalen; if (copy) { zf->data = (unsigned char *) Tcl_AttemptAlloc(datalen); if (!zf->data) { ZIPFS_MEM_ERROR(interp); return TCL_ERROR; } memcpy(zf->data, data, datalen); zf->ptrToFree = zf->data; } else { zf->data = data; 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 -- |
︙ | ︙ | |||
1765 1766 1767 1768 1769 1770 1771 | hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint); /* don't report no-such-mount as an error */ if (!hPtr) { goto done; } | | > > > > > > > > | 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 | hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint); /* don't report no-such-mount as an error */ if (!hPtr) { goto done; } zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (zf->numOpen > 0) { ZIPFS_ERROR(interp, "filesystem is busy"); ZIPFS_ERROR_CODE(interp, "BUSY"); ret = TCL_ERROR; goto done; } Tcl_DeleteHashEntry(hPtr); /* * Now no longer mounted - the rest of the code won't find it - but we're * still cleaning things up. */ for (z = zf->entries; z; z = znext) { znext = z->next; hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } if (z->data) { Tcl_Free(z->data); } Tcl_Free(z); } ZipFSCloseArchive(interp, zf); Tcl_DeleteExitHandler(ZipfsExitHandler, zf); Tcl_Free(zf); unmounted = 1; done: Unlock(); if (unmounted) { Tcl_FSMountsChanged(NULL); } return ret; } |
︙ | ︙ | |||
1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 | static int ZipFSMountObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?zipfile? ?password?"); return TCL_ERROR; } | > > > > > | | > > > > > > > > | > > | > > > > > > > | 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 | static int ZipFSMountObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *mountPoint = NULL, *zipFile = NULL, *password = NULL; Tcl_Obj *zipFileObj = NULL; int result; if (objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?zipfile? ?password?"); return TCL_ERROR; } if (objc > 1) { mountPoint = TclGetString(objv[1]); } if (objc > 2) { zipFileObj = Tcl_FSGetNormalizedPath(interp, objv[2]); if (!zipFileObj) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "could not normalize zip filename", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NORMALIZE", NULL); return TCL_ERROR; } Tcl_IncrRefCount(zipFileObj); zipFile = TclGetString(zipFileObj); } if (objc > 3) { password = TclGetString(objv[3]); } result = TclZipfs_Mount(interp, mountPoint, zipFile, password); if (zipFileObj != NULL) { Tcl_DecrRefCount(zipFileObj); } return result; } /* *------------------------------------------------------------------------- * * ZipFSMountBufferObjCmd -- * |
︙ | ︙ | |||
1855 1856 1857 1858 1859 1860 1861 | TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *mountPoint; /* Mount point path. */ unsigned char *data; | | | 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 | TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *mountPoint; /* Mount point path. */ unsigned char *data; size_t length; if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?"); return TCL_ERROR; } if (objc < 2) { int ret; |
︙ | ︙ | |||
1935 1936 1937 1938 1939 1940 1941 | static int ZipFSUnmountObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | < | 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 | static int ZipFSUnmountObjCmd( TCL_UNUSED(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, "zipfile"); return TCL_ERROR; } return TclZipfs_Unmount(interp, TclGetString(objv[1])); } |
︙ | ︙ | |||
1968 1969 1970 1971 1972 1973 1974 | ZipFSMkKeyObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int len, i = 0; | | > > | < < | > > > | < | | > | > > | > > > > > > > > > > > > > > > > > | > > > > > > > > | > > > | > > > > > > > > > > | > > > | | > | | | | > > > > | > > < > | | | | > > > > > > | | | > | > | | < < < > > > > > | > | > | | | | > > > > > > > | > > > > > > | | | | > | > > > > > > > | | | < < < | | | | | | > > > > > < < | < < < < < < | < < < < < < < < < < < < | < < > > > > > | > > > > > | | | > > | < < | < | | | > | < < < < > > > > > > | > > | < > > | < < | < < | < | < < > > > > > > | | | > > | | | > > > > > | > < < < < < | < | < | | < < < < < < < < | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > | | > > > | > > > > > > > > | | > | | > > > > | > > > | > > | | < < | < < > > > | < < < < < | < | < < | < > < < < > | < | | | | | | < > | > > > | | | | < < < < | 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 | ZipFSMkKeyObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int len, i = 0; const char *pw; Tcl_Obj *passObj; unsigned char *passBuf; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "password"); return TCL_ERROR; } pw = TclGetStringFromObj(objv[1], &len); if (len == 0) { return TCL_OK; } if (IsPasswordValid(interp, pw, len) != TCL_OK) { return TCL_ERROR; } passObj = Tcl_NewByteArrayObj(NULL, 264); passBuf = Tcl_GetByteArrayFromObj(passObj, (int *)NULL); while (len > 0) { int ch = pw[len - 1]; passBuf[i++] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; len--; } passBuf[i] = i; i++; ZipWriteInt(passBuf, passBuf + 264, passBuf + i, ZIP_PASSWORD_END_SIG); Tcl_SetByteArrayLength(passObj, i + 4); Tcl_SetObjResult(interp, passObj); return TCL_OK; } /* *------------------------------------------------------------------------- * * RandomChar -- * * Worker for ZipAddFile(). Picks a random character (range: 0..255) * using Tcl's standard PRNG. * * Returns: * Tcl result code. Updates chPtr with random character on success. * * Side effects: * Advances the PRNG state. May reenter the Tcl interpreter if the user * has replaced the PRNG. * *------------------------------------------------------------------------- */ static int RandomChar( Tcl_Interp *interp, int step, int *chPtr) { double r; Tcl_Obj *ret; if (Tcl_EvalEx(interp, "::tcl::mathfunc::rand", -1, 0) != TCL_OK) { goto failed; } ret = Tcl_GetObjResult(interp); if (Tcl_GetDoubleFromObj(interp, ret, &r) != TCL_OK) { goto failed; } *chPtr = (int) (r * 256); return TCL_OK; failed: Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (evaluating PRNG step %d for password encoding)", step)); return TCL_ERROR; } /* *------------------------------------------------------------------------- * * ZipAddFile -- * * This procedure is used by ZipFSMkZipOrImg() to add a single file to * the output ZIP archive file being written. A ZipEntry struct about the * input file is added to the given fileHash table for later creation of * the central ZIP directory. * * Tcl *always* encodes filenames in the ZIP as UTF-8. Similarly, it * would always encode comments as UTF-8, if it supported comments. * * Results: * A standard Tcl result. * * Side effects: * Input file is read and (compressed and) written to the output ZIP * archive file. * *------------------------------------------------------------------------- */ static int ZipAddFile( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *pathObj, /* Actual name of the file to add. */ const char *name, /* Name to use in the ZIP archive, in Tcl's * internal encoding. */ Tcl_Channel out, /* The open ZIP archive being built. */ const char *passwd, /* Password for encoding the file, or NULL if * the file is to be unprotected. */ char *buf, /* Working buffer. */ int bufsize, /* Size of buf */ Tcl_HashTable *fileHash) /* Where to record ZIP entry metdata so we can * built the central directory. */ { const unsigned char *start = (unsigned char *) buf; const unsigned char *end = (unsigned char *) buf + bufsize; Tcl_Channel in; Tcl_HashEntry *hPtr; ZipEntry *z; z_stream stream; Tcl_DString zpathDs; /* Buffer for the encoded filename. */ const char *zpathExt; /* Filename in external encoding (true * UTF-8). */ const char *zpathTcl; /* Filename in Tcl's internal encoding. */ int crc, flush, zpathlen; size_t nbyte, nbytecompr, len, olen, align = 0; long long headerStartOffset, dataStartOffset, dataEndOffset; int mtime = 0, isNew, compMeth; unsigned long keys[3], keys0[3]; char obuf[4096]; /* * Trim leading '/' characters. If this results in an empty string, we've * nothing to do. */ zpathTcl = name; while (zpathTcl && zpathTcl[0] == '/') { zpathTcl++; } if (!zpathTcl || (zpathTcl[0] == '\0')) { return TCL_OK; } /* * Convert to encoded form. Note that we use strlen() here; if someone's * crazy enough to embed NULs in filenames, they deserve what they get! */ zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs); zpathlen = strlen(zpathExt); if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "path too long for \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "PATH_LEN"); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } in = Tcl_FSOpenFileChannel(interp, pathObj, "rb", 0); if (!in) { Tcl_DStringFree(&zpathDs); #ifdef _WIN32 /* hopefully a directory */ if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) { Tcl_Close(interp, in); return TCL_OK; } #endif /* _WIN32 */ Tcl_Close(interp, in); return TCL_ERROR; } else { Tcl_StatBuf statBuf; if (Tcl_FSStat(pathObj, &statBuf) != -1) { mtime = statBuf.st_mtime; } } Tcl_ResetResult(interp); /* * Compute the CRC. */ crc = 0; nbyte = nbytecompr = 0; while (1) { len = Tcl_Read(in, buf, bufsize); if (len == ERROR_LENGTH) { Tcl_DStringFree(&zpathDs); if (nbyte == 0 && errno == EISDIR) { Tcl_Close(interp, in); return TCL_OK; } readErrorWithChannelOpen: Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s", TclGetString(pathObj), Tcl_PosixError(interp))); Tcl_Close(interp, in); return TCL_ERROR; } if (len == 0) { break; } crc = crc32(crc, (unsigned char *) buf, len); nbyte += len; } if (Tcl_Seek(in, 0, SEEK_SET) == -1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s", TclGetString(pathObj), Tcl_PosixError(interp))); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } /* * Remember where we've got to so far so we can write the header (after * writing the file). */ headerStartOffset = Tcl_Tell(out); /* * Reserve space for the per-file header. Includes writing the file name * as we already know that. */ memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen); len = zpathlen + ZIP_LOCAL_HEADER_LEN; if ((size_t) Tcl_Write(out, buf, len) != len) { writeErrorWithChannelOpen: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on \"%s\": %s", TclGetString(pathObj), Tcl_PosixError(interp))); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } /* * Align payload to next 4-byte boundary (if necessary) using a dummy * extra entry similar to the zipalign tool from Android's SDK. */ if ((len + headerStartOffset) & 3) { unsigned char abuf[8]; const unsigned char *astart = abuf; const unsigned char *aend = abuf + 8; align = 4 + ((len + headerStartOffset) & 3); ZipWriteShort(astart, aend, abuf, 0xffff); ZipWriteShort(astart, aend, abuf + 2, align - 4); ZipWriteInt(astart, aend, abuf + 4, 0x03020100); if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) { goto writeErrorWithChannelOpen; } } /* * Set up encryption if we were asked to. */ if (passwd) { int i, ch, tmp; unsigned char kvbuf[24]; init_keys(passwd, keys, crc32tab); for (i = 0; i < 12 - 2; i++) { if (RandomChar(interp, i, &ch) != TCL_OK) { Tcl_Close(interp, in); return TCL_ERROR; } kvbuf[i + 12] = UCHAR(zencode(keys, crc32tab, ch, tmp)); } Tcl_ResetResult(interp); init_keys(passwd, keys, crc32tab); for (i = 0; i < 12 - 2; i++) { kvbuf[i] = UCHAR(zencode(keys, crc32tab, kvbuf[i + 12], tmp)); } kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 16, tmp)); kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 24, tmp)); len = Tcl_Write(out, (char *) kvbuf, 12); memset(kvbuf, 0, 24); if (len != 12) { goto writeErrorWithChannelOpen; } memcpy(keys0, keys, sizeof(keys0)); nbytecompr += 12; } /* * Save where we've got to in case we need to just store this file. */ Tcl_Flush(out); dataStartOffset = Tcl_Tell(out); /* * Compress the stream. */ compMeth = ZIP_COMPMETH_DEFLATED; memset(&stream, 0, sizeof(z_stream)); stream.zalloc = Z_NULL; stream.zfree = Z_NULL; stream.opaque = Z_NULL; if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) != Z_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "compression init error on \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DEFLATE_INIT"); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } do { len = Tcl_Read(in, buf, bufsize); if (len == ERROR_LENGTH) { deflateEnd(&stream); goto readErrorWithChannelOpen; } stream.avail_in = len; stream.next_in = (unsigned char *) buf; flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH; do { stream.avail_out = sizeof(obuf); stream.next_out = (unsigned char *) obuf; len = deflate(&stream, flush); if (len == (size_t) Z_STREAM_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "deflate error on \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DEFLATE"); deflateEnd(&stream); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } olen = sizeof(obuf) - stream.avail_out; if (passwd) { size_t i; int tmp; for (i = 0; i < olen; i++) { obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); } } if (olen && ((size_t) Tcl_Write(out, obuf, olen) != olen)) { deflateEnd(&stream); goto writeErrorWithChannelOpen; } nbytecompr += olen; } while (stream.avail_out == 0); } while (flush != Z_FINISH); deflateEnd(&stream); /* * Work out where we've got to. */ Tcl_Flush(out); dataEndOffset = Tcl_Tell(out); if (nbyte - nbytecompr <= 0) { /* * Compressed file larger than input, write it again uncompressed. */ if (Tcl_Seek(in, 0, SEEK_SET) != 0) { goto seekErr; } if (Tcl_Seek(out, dataStartOffset, SEEK_SET) != dataStartOffset) { seekErr: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } nbytecompr = (passwd ? 12 : 0); while (1) { len = Tcl_Read(in, buf, bufsize); if (len == ERROR_LENGTH) { goto readErrorWithChannelOpen; } else if (len == 0) { break; } if (passwd) { size_t i; int tmp; for (i = 0; i < len; i++) { buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); } } if ((size_t) Tcl_Write(out, buf, len) != len) { goto writeErrorWithChannelOpen; } nbytecompr += len; } compMeth = ZIP_COMPMETH_STORED; /* * Chop off everything after this; it's the over-large compressed data * and we don't know if it is going to get overwritten otherwise. */ Tcl_Flush(out); dataEndOffset = Tcl_Tell(out); Tcl_TruncateChannel(out, dataEndOffset); } Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); zpathExt = NULL; hPtr = Tcl_CreateHashEntry(fileHash, zpathTcl, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "non-unique path name \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DUPLICATE_PATH"); return TCL_ERROR; } /* * Remember that we've written the file (for central directory generation) * and generate the local (per-file) header in the space that we reserved * earlier. */ z = AllocateZipEntry(); Tcl_SetHashValue(hPtr, z); z->isEncrypted = (passwd ? 1 : 0); z->offset = headerStartOffset; z->crc32 = crc; z->timestamp = mtime; z->numBytes = nbyte; z->numCompressedBytes = nbytecompr; z->compressMethod = compMeth; z->name = (char *) Tcl_GetHashKey(fileHash, hPtr); /* * Write final local header information. */ SerializeLocalEntryHeader(start, end, (unsigned char *) buf, z, zpathlen, align); if (Tcl_Seek(out, headerStartOffset, SEEK_SET) != headerStartOffset) { Tcl_DeleteHashEntry(hPtr); Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; } if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { Tcl_DeleteHashEntry(hPtr); Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); return TCL_ERROR; } Tcl_Flush(out); if (Tcl_Seek(out, dataEndOffset, SEEK_SET) != dataEndOffset) { Tcl_DeleteHashEntry(hPtr); Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; } /* *------------------------------------------------------------------------- * * ZipFSFind -- * * Worker for ZipFSMkZipOrImg() that discovers the list of files to add. * Simple wrapper around [zipfs find]. * *------------------------------------------------------------------------- */ static Tcl_Obj * ZipFSFind( Tcl_Interp *interp, Tcl_Obj *dirRoot) { Tcl_Obj *cmd[2]; int result; cmd[0] = Tcl_NewStringObj("::tcl::zipfs::find", -1); cmd[1] = dirRoot; Tcl_IncrRefCount(cmd[0]); result = Tcl_EvalObjv(interp, 2, cmd, 0); Tcl_DecrRefCount(cmd[0]); if (result != TCL_OK) { return NULL; } return Tcl_GetObjResult(interp); } /* *------------------------------------------------------------------------- * * ComputeNameInArchive -- * * Helper for ZipFSMkZipOrImg() that computes what the actual name of a * file in the ZIP archive should be, stripping a prefix (if appropriate) * and any leading slashes. If the result is an empty string, the entry * should be skipped. * * Returns: * Pointer to the name (in Tcl's internal encoding), which will be in * memory owned by one of the argument objects. * * Side effects: * None (if Tcl_Objs have string representations) * *------------------------------------------------------------------------- */ static inline const char * ComputeNameInArchive( Tcl_Obj *pathObj, /* The path to the origin file */ Tcl_Obj *directNameObj, /* User-specified name for use in the ZIP * archive */ const char *strip, /* A prefix to strip; may be NULL if no * stripping need be done. */ int slen) /* The length of the prefix; must be 0 if no * stripping need be done. */ { const char *name; int len; if (directNameObj) { name = TclGetString(directNameObj); } else { name = TclGetStringFromObj(pathObj, &len); if (slen > 0) { if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { /* * Guaranteed to be a NUL at the end, which will make this * entry be skipped. */ return name + len; } name += slen; } } while (name[0] == '/') { ++name; } return name; } /* *------------------------------------------------------------------------- * * ZipFSMkZipOrImg -- * * This procedure is creates a new ZIP archive file or image file given * output filename, input directory of files to be archived, optional * password, and optional image to be prepended to the output ZIP archive * file. It's the core of the implementation of [zipfs mkzip], [zipfs * mkimg], [zipfs lmkzip] and [zipfs lmkimg]. * * Tcl *always* encodes filenames in the ZIP as UTF-8. Similarly, it * would always encode comments as UTF-8, if it supported comments. * * Results: * A standard Tcl result. * * Side effects: * A new ZIP archive file or image file is written. * *------------------------------------------------------------------------- */ static int ZipFSMkZipOrImg( Tcl_Interp *interp, /* Current interpreter. */ int isImg, /* Are we making an image? */ Tcl_Obj *targetFile, /* What file are we making? */ Tcl_Obj *dirRoot, /* What directory do we take files from? Do * not specify at the same time as * mappingList (one must be NULL). */ Tcl_Obj *mappingList, /* What files are we putting in, and with what * names? Do not specify at the same time as * dirRoot (one must be NULL). */ Tcl_Obj *originFile, /* If we're making an image, what file does * the non-ZIP part of the image come from? */ Tcl_Obj *stripPrefix, /* Are we going to strip a prefix from * filenames found beneath dirRoot? If NULL, * do not strip anything (except for dirRoot * 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 dataStartOffset; /* The overall file offset of the start of the * data section of the file. */ 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; ZipEntry *z; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_HashTable fileHash; char *strip = NULL, *pw = NULL, passBuf[264], buf[4096]; unsigned char *start = (unsigned char *) buf; unsigned char *end = start + sizeof(buf); /* * Caller has verified that the number of arguments is correct. */ passBuf[0] = 0; if (passwordObj != NULL) { pw = TclGetStringFromObj(passwordObj, &pwlen); if (IsPasswordValid(interp, pw, pwlen) != TCL_OK) { return TCL_ERROR; } if (pwlen <= 0) { pw = NULL; pwlen = 0; } } if (dirRoot != NULL) { list = ZipFSFind(interp, dirRoot); if (!list) { return TCL_ERROR; } } Tcl_IncrRefCount(list); if (Tcl_ListObjGetElements(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"); return TCL_ERROR; } if (lobjc == 0) { Tcl_DecrRefCount(list); ZIPFS_ERROR(interp, "empty archive"); ZIPFS_ERROR_CODE(interp, "EMPTY"); return TCL_ERROR; } out = Tcl_FSOpenFileChannel(interp, targetFile, "wb", 0755); if (out == NULL) { Tcl_DecrRefCount(list); return TCL_ERROR; } /* * Copy the existing contents from the image if it is an executable image. * Care must be taken because this might include an existing ZIP, which * needs to be stripped. */ if (isImg) { ZipFile *zf, zf0; int isMounted = 0; const char *imgName; // TODO: normalize the origin file name imgName = (originFile != NULL) ? TclGetString(originFile) : Tcl_GetNameOfExecutable(); if (pwlen) { i = 0; for (len = pwlen; len-- > 0;) { int ch = pw[len]; passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; i++; |
︙ | ︙ | |||
2497 2498 2499 2500 2501 2502 2503 | /* * Check for mounted image. */ WriteLock(); for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { | | > > > > > > | | < < < < < < | < | < < < < < < < < < < | < < < < < | < < < < < < < < < < < < < > | > | | > > > > > | | | > | | > | | | < < | < < < < < < | < < < < < < | > > > > > | | | | | < < < < < < < < | < < < < < < < < < | | | | | < < < < < < < | < < < < < < | | | > > > > > > > | < < < < < < < < > > | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > < | | > > > | > > > < | | > > | > | | > > < | | > > > > | > > > < | | > > > | > | 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 | /* * Check for mounted image. */ WriteLock(); for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (strcmp(zf->name, imgName) == 0) { isMounted = 1; zf->numOpen++; break; } } Unlock(); if (!isMounted) { zf = &zf0; memset(&zf0, 0, sizeof(ZipFile)); } if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) { /* * Copy everything up to the ZIP-related suffix. */ if ((size_t) Tcl_Write(out, (char *) zf->data, zf->passOffset) != zf->passOffset) { memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); Tcl_Close(interp, out); if (zf == &zf0) { ZipFSCloseArchive(interp, zf); } else { WriteLock(); zf->numOpen--; Unlock(); } return TCL_ERROR; } if (zf == &zf0) { ZipFSCloseArchive(interp, zf); } else { WriteLock(); zf->numOpen--; Unlock(); } } else { /* * Fall back to read it as plain file which hopefully is a static * tclsh or wish binary with proper zipfs infrastructure built in. */ if (CopyImageFile(interp, imgName, out) != TCL_OK) { memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); Tcl_Close(interp, out); return TCL_ERROR; } } /* * Store the password so that the automounter can find it. */ len = strlen(passBuf); if (len > 0) { i = Tcl_Write(out, passBuf, len); if (i != len) { Tcl_DecrRefCount(list); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); Tcl_Close(interp, out); return TCL_ERROR; } } memset(passBuf, 0, sizeof(passBuf)); Tcl_Flush(out); } /* * Prepare the contents of the ZIP archive. */ Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS); dataStartOffset = Tcl_Tell(out); if (mappingList == NULL && stripPrefix != NULL) { strip = TclGetStringFromObj(stripPrefix, &slen); if (!slen) { strip = NULL; } } for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) { Tcl_Obj *pathObj = lobjv[i]; const char *name = ComputeNameInArchive(pathObj, (mappingList ? lobjv[i + 1] : NULL), strip, slen); if (name[0] == '\0') { continue; } if (ZipAddFile(interp, pathObj, name, out, pw, buf, sizeof(buf), &fileHash) != TCL_OK) { goto done; } } /* * Construct the contents of the ZIP central directory. */ directoryStartOffset = Tcl_Tell(out); count = 0; for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) { const char *name = ComputeNameInArchive(lobjv[i], (mappingList ? lobjv[i + 1] : NULL), strip, slen); Tcl_DString ds; hPtr = Tcl_FindHashEntry(&fileHash, name); if (!hPtr) { 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, dataStartOffset); 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, dataStartOffset, 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; done: if (ret == TCL_OK) { ret = Tcl_Close(interp, out); } else { Tcl_Close(interp, out); } Tcl_DecrRefCount(list); for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { z = (ZipEntry *) Tcl_GetHashValue(hPtr); Tcl_Free(z); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&fileHash); return ret; } /* * --------------------------------------------------------------------- * * CopyImageFile -- * * A simple file copy function that is used (by ZipFSMkZipOrImg) for * anything that is not an image with a ZIP appended. * * Returns: * A Tcl result code. * * Side effects: * Writes to an output channel. * * --------------------------------------------------------------------- */ static int CopyImageFile( Tcl_Interp *interp, /* For error reporting. */ const char *imgName, /* Where to copy from. */ Tcl_Channel out) /* Where to copy to; already open for writing * binary data. */ { size_t i, k; int m, n; Tcl_Channel in; char buf[4096]; const char *errMsg; Tcl_ResetResult(interp); in = Tcl_OpenFileChannel(interp, imgName, "rb", 0644); if (!in) { return TCL_ERROR; } /* * Get the length of the file (and exclude non-files). */ i = Tcl_Seek(in, 0, SEEK_END); if (i == ERROR_LENGTH) { errMsg = "seek error"; goto copyError; } Tcl_Seek(in, 0, SEEK_SET); /* * Copy the whole file, 8 blocks at a time (reasonably efficient). Note * that this totally ignores things like Windows's Alternate File Streams. */ for (k = 0; k < i; k += m) { m = i - k; if (m > (int) sizeof(buf)) { m = (int) sizeof(buf); } n = Tcl_Read(in, buf, m); if (n == -1) { errMsg = "read error"; goto copyError; } else if (n == 0) { break; } m = Tcl_Write(out, buf, n); if (m != n) { errMsg = "write error"; goto copyError; } } Tcl_Close(interp, in); return TCL_OK; copyError: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s: %s", errMsg, Tcl_PosixError(interp))); Tcl_Close(interp, in); return TCL_ERROR; } /* * --------------------------------------------------------------------- * * SerializeLocalEntryHeader, SerializeCentralDirectoryEntry, * SerializeCentralDirectorySuffix -- * * Create serialized forms of the structures that make up the ZIP * metadata. Note that the both the local entry and the central directory * entry need to have the name of the entry written directly afterwards. * * We could write these as structs except we need to guarantee that we * are writing these out as little-endian values. * * Side effects: * Both update their buffer arguments, but otherwise change nothing. * * --------------------------------------------------------------------- */ static void SerializeLocalEntryHeader( const unsigned char *start, /* The start of writable memory. */ const unsigned char *end, /* The end of writable memory. */ unsigned char *buf, /* Where to serialize to */ ZipEntry *z, /* The description of what to serialize. */ int nameLength, /* The length of the name. */ int align) /* The number of alignment bytes. */ { ZipWriteInt(start, end, buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG); ZipWriteShort(start, end, buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION); ZipWriteShort(start, end, buf + ZIP_LOCAL_FLAGS_OFFS, z->isEncrypted); ZipWriteShort(start, end, buf + ZIP_LOCAL_COMPMETH_OFFS, z->compressMethod); ZipWriteShort(start, end, buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp)); ZipWriteShort(start, end, buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp)); ZipWriteInt(start, end, buf + ZIP_LOCAL_CRC32_OFFS, z->crc32); ZipWriteInt(start, end, buf + ZIP_LOCAL_COMPLEN_OFFS, z->numCompressedBytes); ZipWriteInt(start, end, buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->numBytes); ZipWriteShort(start, end, buf + ZIP_LOCAL_PATHLEN_OFFS, nameLength); ZipWriteShort(start, end, buf + ZIP_LOCAL_EXTRALEN_OFFS, align); } 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. */ long long dataStartOffset) /* The overall file offset of the start of the * data section of the file. */ { 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); ZipWriteShort(start, end, buf + ZIP_CENTRAL_COMPMETH_OFFS, z->compressMethod); ZipWriteShort(start, end, buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp)); ZipWriteShort(start, end, buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp)); ZipWriteInt(start, end, buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32); ZipWriteInt(start, end, buf + ZIP_CENTRAL_COMPLEN_OFFS, z->numCompressedBytes); ZipWriteInt(start, end, buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->numBytes); ZipWriteShort(start, end, buf + ZIP_CENTRAL_PATHLEN_OFFS, nameLength); ZipWriteShort(start, end, buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0); ZipWriteShort(start, end, buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0); ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKFILE_OFFS, 0); ZipWriteShort(start, end, buf + ZIP_CENTRAL_IATTR_OFFS, 0); ZipWriteInt(start, end, buf + ZIP_CENTRAL_EATTR_OFFS, 0); ZipWriteInt(start, end, buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - dataStartOffset); } 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 dataStartOffset, /* The overall file offset of the start of the * data section of the file. */ 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 - dataStartOffset); ZipWriteShort(start, end, buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0); } /* *------------------------------------------------------------------------- * * ZipFSMkZipObjCmd, ZipFSLMkZipObjCmd -- * * These procedures are invoked to process the [zipfs mkzip] and [zipfs * lmkzip] commands. See description of ZipFSMkZipOrImg(). * * Results: * A standard Tcl result. * * Side effects: * See description of ZipFSMkZipOrImg(). * *------------------------------------------------------------------------- */ static int ZipFSMkZipObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *stripPrefix, *password; if (objc < 3 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "outfile indir ?strip? ?password?"); return TCL_ERROR; } if (Tcl_IsSafe(interp)) { ZIPFS_ERROR(interp, "operation not permitted in a safe interpreter"); ZIPFS_ERROR_CODE(interp, "SAFE_INTERP"); return TCL_ERROR; } stripPrefix = (objc > 3 ? objv[3] : NULL); password = (objc > 4 ? objv[4] : NULL); return ZipFSMkZipOrImg(interp, 0, objv[1], objv[2], NULL, NULL, stripPrefix, password); } static int ZipFSLMkZipObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *password; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password?"); return TCL_ERROR; } if (Tcl_IsSafe(interp)) { ZIPFS_ERROR(interp, "operation not permitted in a safe interpreter"); ZIPFS_ERROR_CODE(interp, "SAFE_INTERP"); return TCL_ERROR; } password = (objc > 3 ? objv[3] : NULL); return ZipFSMkZipOrImg(interp, 0, objv[1], NULL, objv[2], NULL, NULL, password); } /* *------------------------------------------------------------------------- * * ZipFSMkImgObjCmd, ZipFSLMkImgObjCmd -- * * These procedures are invoked to process the [zipfs mkimg] and [zipfs * lmkimg] commands. See description of ZipFSMkZipOrImg(). * * Results: * A standard Tcl result. * * Side effects: * See description of ZipFSMkZipOrImg(). * *------------------------------------------------------------------------- */ static int ZipFSMkImgObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *originFile, *stripPrefix, *password; if (objc < 3 || objc > 6) { Tcl_WrongNumArgs(interp, 1, objv, "outfile indir ?strip? ?password? ?infile?"); return TCL_ERROR; } if (Tcl_IsSafe(interp)) { ZIPFS_ERROR(interp, "operation not permitted in a safe interpreter"); ZIPFS_ERROR_CODE(interp, "SAFE_INTERP"); return TCL_ERROR; } originFile = (objc > 5 ? objv[5] : NULL); stripPrefix = (objc > 3 ? objv[3] : NULL); password = (objc > 4 ? objv[4] : NULL); return ZipFSMkZipOrImg(interp, 1, objv[1], objv[2], NULL, originFile, stripPrefix, password); } static int ZipFSLMkImgObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *originFile, *password; if (objc < 3 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password infile?"); return TCL_ERROR; } if (Tcl_IsSafe(interp)) { ZIPFS_ERROR(interp, "operation not permitted in a safe interpreter"); ZIPFS_ERROR_CODE(interp, "SAFE_INTERP"); return TCL_ERROR; } originFile = (objc > 4 ? objv[4] : NULL); password = (objc > 3 ? objv[3] : NULL); return ZipFSMkZipOrImg(interp, 1, objv[1], NULL, objv[2], originFile, NULL, password); } /* *------------------------------------------------------------------------- * * ZipFSCanonicalObjCmd -- * |
︙ | ︙ | |||
2948 2949 2950 2951 2952 2953 2954 | } /* *------------------------------------------------------------------------- * * ZipFSInfoObjCmd -- * | | | 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 | } /* *------------------------------------------------------------------------- * * ZipFSInfoObjCmd -- * * This procedure is invoked to process the [zipfs info] command. On * success, it returns a Tcl list made up of name of ZIP archive file, * size uncompressed, size compressed, and archive offset of a file in * the ZIP filesystem. * * Results: * A standard Tcl result. * |
︙ | ︙ | |||
3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 | Tcl_Obj *const objv[]) /* Argument objects. */ { char *pattern = NULL; Tcl_RegExp regexp = NULL; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *result = Tcl_GetObjResult(interp); if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); return TCL_ERROR; } if (objc == 3) { | > > > > > > | | > > > | < > > < > > < < < < | > > > > > | | | | 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 | Tcl_Obj *const objv[]) /* Argument objects. */ { char *pattern = NULL; Tcl_RegExp regexp = NULL; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *result = Tcl_GetObjResult(interp); const char *options[] = {"-glob", "-regexp", NULL}; enum list_options { OPT_GLOB, OPT_REGEXP }; /* * Parse arguments. */ if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); return TCL_ERROR; } if (objc == 3) { int idx; if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &idx) != TCL_OK) { return TCL_ERROR; } switch (idx) { case OPT_GLOB: pattern = TclGetString(objv[2]); break; case OPT_REGEXP: regexp = Tcl_RegExpCompile(interp, TclGetString(objv[2])); if (!regexp) { return TCL_ERROR; } break; } } else if (objc == 2) { pattern = TclGetString(objv[1]); } /* * Scan for matching entries. */ ReadLock(); if (pattern) { for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); if (Tcl_StringMatch(z->name, pattern)) { Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); } } } else if (regexp) { for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) { Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); } } } else { for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); } } Unlock(); return TCL_OK; |
︙ | ︙ | |||
3102 3103 3104 3105 3106 3107 3108 | * Side effects: * May initialise the cache of where such library files are to be found. * This cache is never cleared. * *------------------------------------------------------------------------- */ | < < < < | > | 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 | * Side effects: * May initialise the cache of where such library files are to be found. * This cache is never cleared. * *------------------------------------------------------------------------- */ Tcl_Obj * TclZipfs_TclLibrary(void) { Tcl_Obj *vfsInitScript; int found; #if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(STATIC_BUILD) # define LIBRARY_SIZE 64 HMODULE hModule; WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char dllName[(MAX_PATH + LIBRARY_SIZE) * 3]; #endif /* _WIN32 */ /* * Use the cached value if that has been set; we don't want to repeat the |
︙ | ︙ | |||
3145 3146 3147 3148 3149 3150 3151 | } /* * Look for the library file system within the DLL/shared library. Note * that we must mount the zip file and dll before releasing to search. */ | > | > > > > | < | | | < < < < < < < < < < < < < < < < < | 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 | } /* * Look for the library file system within the DLL/shared library. Note * that we must mount the zip file and dll before releasing to search. */ #if !defined(STATIC_BUILD) #if defined(_WIN32) || defined(__CYGWIN__) hModule = (HMODULE)TclWinGetTclInstance(); GetModuleFileNameW(hModule, wName, MAX_PATH); #ifdef __CYGWIN__ cygwin_conv_path(3, wName, dllName, sizeof(dllName)); #else WideCharToMultiByte(CP_UTF8, 0, wName, -1, dllName, sizeof(dllName), NULL, NULL); #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) */ /* * If anything set the cache (but subsequently failed) go with that * anyway. */ if (zipfs_literal_tcl_library) { |
︙ | ︙ | |||
3249 3250 3251 3252 3253 3254 3255 | static int ZipChannelClose( void *instanceData, TCL_UNUSED(Tcl_Interp *), int flags) { | | | > | 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 | static int ZipChannelClose( void *instanceData, TCL_UNUSED(Tcl_Interp *), int flags) { ZipChannel *info = (ZipChannel *) instanceData; if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { return EINVAL; } if (info->iscompr && info->ubuf) { Tcl_Free(info->ubuf); info->ubuf = NULL; } if (info->isEncrypted) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); } if (info->isWriting) { ZipEntry *z = info->zipEntryPtr; unsigned char *newdata = (unsigned char *) Tcl_AttemptRealloc(info->ubuf, info->numRead); if (newdata) { if (z->data) { Tcl_Free(z->data); } z->data = newdata; z->numBytes = z->numCompressedBytes = info->numBytes; |
︙ | ︙ | |||
3426 3427 3428 3429 3430 3431 3432 | * * Side effects: * File pointer is repositioned according to offset and mode. * *------------------------------------------------------------------------- */ | | | | 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 | * * Side effects: * File pointer is repositioned according to offset and mode. * *------------------------------------------------------------------------- */ static long long ZipChannelWideSeek( void *instanceData, long long offset, int mode, int *errloc) { ZipChannel *info = (ZipChannel *) instanceData; size_t end; if (!info->isWriting && (info->isDirectory < 0)) { |
︙ | ︙ | |||
3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 | } else if ((size_t) offset > end) { *errloc = EINVAL; return -1; } info->numRead = (size_t) offset; return info->numRead; } /* *------------------------------------------------------------------------- * * ZipChannelWatchChannel -- * * This function is called for event notifications on channel. Does | > > > > > > > > > > > > | 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 | } else if ((size_t) offset > end) { *errloc = EINVAL; return -1; } info->numRead = (size_t) offset; return info->numRead; } #if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) static int ZipChannelSeek( void *instanceData, long offset, int mode, int *errloc) { return ZipChannelWideSeek(instanceData, offset, mode, errloc); } #endif /* *------------------------------------------------------------------------- * * ZipChannelWatchChannel -- * * This function is called for event notifications on channel. Does |
︙ | ︙ | |||
3538 3539 3540 3541 3542 3543 3544 | /* *------------------------------------------------------------------------- * * ZipChannelOpen -- * * This function opens a Tcl_Channel on a file from a mounted ZIP archive | | | | | | < < > | < < < > | < < | > > > | | < < > | > > | > | | < < | < < | < < | > < < < < < > > > > > > > > > > > > | > > | > > > > | > > | > > > | > > > | > > > > > | | > > > | > > > > > > > > > | > > > > > > > | | > | > > > > > > > > | > > > | > > | > > | | | > | > > > > | | > > > > | | | | | | | < | < < < | < < < > | < < < < < < < < < < < < | < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | > < < | > > | | < | | | | | < < < < < < < < < < < < < < < | | | < | < > | < | < < > > > | > | | < < < < < < | < < < < < > > > > > > | > > > > > > | > | > | > > > > > > > > | > > > > > > > > > > > > > > > > > | > > > > > > > > > > | > > > > > | > > > > > > > > > > > > > > > > > > > > | > | > > > > > > > > > > > > > > > > > | | > | > > > > | > > > | > > | > > > > | > > > > | > > > > > > > > | > > > > | > > > > > > > > > > > > > | > > > > > | > > > > > > > | | > > > > > | | 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 | /* *------------------------------------------------------------------------- * * ZipChannelOpen -- * * This function opens a Tcl_Channel on a file from a mounted ZIP archive * according to given open mode (already parsed by caller). * * Results: * Tcl_Channel on success, or NULL on error. * * Side effects: * Memory is allocated, the file from the ZIP archive is uncompressed. * *------------------------------------------------------------------------- */ static Tcl_Channel ZipChannelOpen( Tcl_Interp *interp, /* Current interpreter. */ char *filename, /* What are we opening. */ int wr, /* True if we're opening in write mode. */ int trunc) /* True if we're opening in truncate mode. */ { ZipEntry *z; ZipChannel *info; int flags = 0; char cname[128]; /* * Is the file there? */ WriteLock(); z = ZipFSLookup(filename); if (!z) { Tcl_SetErrno(ENOENT); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "file not found \"%s\": %s", filename, Tcl_PosixError(interp))); } goto error; } /* * Do we support opening the file that way? */ if (wr && z->isDirectory) { Tcl_SetErrno(EISDIR); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unsupported file type: %s", Tcl_PosixError(interp))); } goto error; } if ((z->compressMethod != ZIP_COMPMETH_STORED) && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) { ZIPFS_ERROR(interp, "unsupported compression method"); ZIPFS_ERROR_CODE(interp, "COMP_METHOD"); goto error; } if (!trunc) { flags |= TCL_READABLE; if (z->isEncrypted && (z->zipFilePtr->passBuf[0] == 0)) { ZIPFS_ERROR(interp, "decryption failed"); ZIPFS_ERROR_CODE(interp, "DECRYPT"); goto error; } else if (wr && !z->data && (z->numBytes > ZipFS.wrmax)) { ZIPFS_ERROR(interp, "file too large"); ZIPFS_ERROR_CODE(interp, "FILE_SIZE"); goto error; } } else { flags = TCL_WRITABLE; } info = AllocateZipChannel(interp); if (!info) { goto error; } info->zipFilePtr = z->zipFilePtr; info->zipEntryPtr = z; if (wr) { /* * Set up a writable channel. */ flags |= TCL_WRITABLE; if (InitWritableChannel(interp, info, z, trunc) == TCL_ERROR) { Tcl_Free(info); goto error; } } else if (z->data) { /* * Set up a readable channel for direct data. */ flags |= TCL_READABLE; info->numBytes = z->numBytes; info->ubuf = z->data; } else { /* * Set up a readable channel. */ flags |= TCL_READABLE; if (InitReadableChannel(interp, info, z) == TCL_ERROR) { Tcl_Free(info); goto error; } } /* * Wrap the ZipChannel into a Tcl_Channel. */ sprintf(cname, "zipfs_%" TCL_Z_MODIFIER "x_%d", z->offset, ZipFS.idCount++); z->zipFilePtr->numOpen++; Unlock(); return Tcl_CreateChannel(&ZipChannelType, cname, info, flags); error: Unlock(); return NULL; } /* *------------------------------------------------------------------------- * * InitWritableChannel -- * * Assistant for ZipChannelOpen() that sets up a writable channel. It's * up to the caller to actually register the channel. * * Returns: * Tcl result code. * * Side effects: * Allocates memory for the implementation of the channel. Writes to the * interpreter's result on error. * *------------------------------------------------------------------------- */ static int InitWritableChannel( Tcl_Interp *interp, /* Current interpreter, or NULL (when errors * will be silent). */ ZipChannel *info, /* The channel to set up. */ ZipEntry *z, /* The zipped file that the channel will write * to. */ int trunc) /* Whether to truncate the data. */ { int i, ch; unsigned char *cbuf = NULL; /* * Set up a writable channel. */ info->isWriting = 1; info->maxWrite = ZipFS.wrmax; info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->maxWrite); if (!info->ubuf) { goto memoryError; } memset(info->ubuf, 0, info->maxWrite); if (trunc) { /* * Truncate; nothing there. */ info->numBytes = 0; } else if (z->data) { /* * Already got uncompressed data. */ unsigned int j = z->numBytes; if (j > info->maxWrite) { j = info->maxWrite; } memcpy(info->ubuf, z->data, j); info->numBytes = j; } else { /* * Need to uncompress the existing data. */ unsigned char *zbuf = z->zipFilePtr->data + z->offset; if (z->isEncrypted) { int len = z->zipFilePtr->passBuf[0] & 0xFF; char passBuf[260]; for (i = 0; i < len; i++) { ch = z->zipFilePtr->passBuf[len - i]; passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; } passBuf[i] = '\0'; init_keys(passBuf, info->keys, crc32tab); memset(passBuf, 0, sizeof(passBuf)); for (i = 0; i < 12; i++) { ch = info->ubuf[i]; zdecode(info->keys, crc32tab, ch); } zbuf += i; } if (z->compressMethod == ZIP_COMPMETH_DEFLATED) { z_stream stream; int err; memset(&stream, 0, sizeof(z_stream)); stream.zalloc = Z_NULL; stream.zfree = Z_NULL; stream.opaque = Z_NULL; stream.avail_in = z->numCompressedBytes; if (z->isEncrypted) { unsigned int j; stream.avail_in -= 12; cbuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); if (!cbuf) { goto memoryError; } for (j = 0; j < stream.avail_in; j++) { ch = info->ubuf[j]; cbuf[j] = zdecode(info->keys, crc32tab, ch); } stream.next_in = cbuf; } else { stream.next_in = zbuf; } stream.next_out = info->ubuf; stream.avail_out = info->maxWrite; if (inflateInit2(&stream, -15) != Z_OK) { goto corruptionError; } err = inflate(&stream, Z_SYNC_FLUSH); inflateEnd(&stream); if ((err == Z_STREAM_END) || ((err == Z_OK) && (stream.avail_in == 0))) { if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); Tcl_Free(cbuf); } return TCL_OK; } goto corruptionError; } else if (z->isEncrypted) { /* * Need to decrypt some otherwise-simple stored data. */ for (i = 0; i < z->numBytes - 12; i++) { ch = zbuf[i]; info->ubuf[i] = zdecode(info->keys, crc32tab, ch); } } else { /* * Simple stored data. Copy into our working buffer. */ memcpy(info->ubuf, zbuf, z->numBytes); } memset(info->keys, 0, sizeof(info->keys)); } return TCL_OK; memoryError: if (info->ubuf) { Tcl_Free(info->ubuf); } ZIPFS_MEM_ERROR(interp); return TCL_ERROR; corruptionError: if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); Tcl_Free(cbuf); } if (info->ubuf) { Tcl_Free(info->ubuf); } ZIPFS_ERROR(interp, "decompression error"); ZIPFS_ERROR_CODE(interp, "CORRUPT"); return TCL_ERROR; } /* *------------------------------------------------------------------------- * * InitReadableChannel -- * * Assistant for ZipChannelOpen() that sets up a readable channel. It's * up to the caller to actually register the channel. * * Returns: * Tcl result code. * * Side effects: * Allocates memory for the implementation of the channel. Writes to the * interpreter's result on error. * *------------------------------------------------------------------------- */ static int InitReadableChannel( Tcl_Interp *interp, /* Current interpreter, or NULL (when errors * will be silent). */ ZipChannel *info, /* The channel to set up. */ ZipEntry *z) /* The zipped file that the channel will read * from. */ { unsigned char *ubuf = NULL; int i, ch; info->iscompr = (z->compressMethod == ZIP_COMPMETH_DEFLATED); info->ubuf = z->zipFilePtr->data + z->offset; info->isDirectory = z->isDirectory; info->isEncrypted = z->isEncrypted; info->numBytes = z->numBytes; if (info->isEncrypted) { int len = z->zipFilePtr->passBuf[0] & 0xFF; char passBuf[260]; for (i = 0; i < len; i++) { ch = z->zipFilePtr->passBuf[len - i]; passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; } passBuf[i] = '\0'; init_keys(passBuf, info->keys, crc32tab); memset(passBuf, 0, sizeof(passBuf)); for (i = 0; i < 12; i++) { ch = info->ubuf[i]; zdecode(info->keys, crc32tab, ch); } info->ubuf += i; } if (info->iscompr) { z_stream stream; int err; unsigned int j; /* * Data to decode is compressed, and possibly encrpyted too. */ memset(&stream, 0, sizeof(z_stream)); stream.zalloc = Z_NULL; stream.zfree = Z_NULL; stream.opaque = Z_NULL; stream.avail_in = z->numCompressedBytes; if (info->isEncrypted) { stream.avail_in -= 12; ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); if (!ubuf) { info->ubuf = NULL; goto memoryError; } for (j = 0; j < stream.avail_in; j++) { ch = info->ubuf[j]; ubuf[j] = zdecode(info->keys, crc32tab, ch); } stream.next_in = ubuf; } else { stream.next_in = info->ubuf; } stream.next_out = info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->numBytes); if (!info->ubuf) { goto memoryError; } stream.avail_out = info->numBytes; if (inflateInit2(&stream, -15) != Z_OK) { goto corruptionError; } err = inflate(&stream, Z_SYNC_FLUSH); inflateEnd(&stream); /* * Decompression was successful if we're either in the END state, or * in the OK state with no buffered bytes. */ if ((err != Z_STREAM_END) && ((err != Z_OK) || (stream.avail_in != 0))) { goto corruptionError; } if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); Tcl_Free(ubuf); } return TCL_OK; } else if (info->isEncrypted) { unsigned int j, len; /* * Decode encrypted but uncompressed file, since we support Tcl_Seek() * on it, and it can be randomly accessed later. */ len = z->numCompressedBytes - 12; ubuf = (unsigned char *) Tcl_AttemptAlloc(len); if (ubuf == NULL) { goto memoryError; } for (j = 0; j < len; j++) { ch = info->ubuf[j]; ubuf[j] = zdecode(info->keys, crc32tab, ch); } info->ubuf = ubuf; info->isEncrypted = 0; } return TCL_OK; corruptionError: if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); Tcl_Free(ubuf); } if (info->ubuf) { Tcl_Free(info->ubuf); } ZIPFS_ERROR(interp, "decompression error"); ZIPFS_ERROR_CODE(interp, "CORRUPT"); return TCL_ERROR; memoryError: if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); Tcl_Free(ubuf); } ZIPFS_MEM_ERROR(interp); return TCL_ERROR; } /* *------------------------------------------------------------------------- * * ZipEntryStat -- * |
︙ | ︙ | |||
3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 | } /* *------------------------------------------------------------------------- * * ZipFSOpenFileChannelProc -- * * Results: * * Side effects: * *------------------------------------------------------------------------- */ static Tcl_Channel ZipFSOpenFileChannelProc( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *pathPtr, int mode, | > > > > > | > > > > > > > > > > > > > > > > > > | < | 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 | } /* *------------------------------------------------------------------------- * * ZipFSOpenFileChannelProc -- * * Open a channel to a file in a mounted ZIP archive. Delegates to * ZipChannelOpen(). * * Results: * Tcl_Channel on success, or NULL on error. * * Side effects: * Allocates memory. * *------------------------------------------------------------------------- */ static Tcl_Channel ZipFSOpenFileChannelProc( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *pathPtr, int mode, TCL_UNUSED(int) /* permissions */) { int trunc = (mode & O_TRUNC) != 0; int wr = (mode & (O_WRONLY | O_RDWR)) != 0; pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return NULL; } /* * Check for unsupported modes. */ if ((mode & O_APPEND) || ((ZipFS.wrmax <= 0) && wr)) { Tcl_SetErrno(EACCES); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write access not supported: %s", Tcl_PosixError(interp))); } return NULL; } return ZipChannelOpen(interp, TclGetString(pathPtr), wr, trunc); } /* *------------------------------------------------------------------------- * * ZipFSStatProc -- * |
︙ | ︙ | |||
4017 4018 4019 4020 4021 4022 4023 | */ static int ZipFSStatProc( Tcl_Obj *pathPtr, Tcl_StatBuf *buf) { | < | 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 | */ static int ZipFSStatProc( Tcl_Obj *pathPtr, Tcl_StatBuf *buf) { pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return -1; } return ZipEntryStat(TclGetString(pathPtr), buf); } |
︙ | ︙ | |||
4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 | { return Tcl_NewStringObj("/", -1); } /* *------------------------------------------------------------------------- * * ZipFSMatchInDirectoryProc -- * * This routine is used by the globbing code to search a directory for * all files which match a given pattern. * * Results: * The return value is a standard Tcl result indicating whether an error * occurred in globbing. Errors are left in interp, good results are * lappend'ed to resultPtr (which must be a valid object). * * Side effects: * None. * *------------------------------------------------------------------------- */ static int ZipFSMatchInDirectoryProc( TCL_UNUSED(Tcl_Interp *), | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | > < < | > | > > | > | < > > < < < < < < | < < < < < < | | < | < < < < < < | | < < < < < | < < < | | < < < < < > | < < < < < < < | < < < > | < < < < < < < | | | < | < < < < < < < | > | | > > > | > | < | > | < < < < < < < < | < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 | { return Tcl_NewStringObj("/", -1); } /* *------------------------------------------------------------------------- * * AppendWithPrefix -- * * Worker for ZipFSMatchInDirectoryProc() that is a wrapper around * Tcl_ListObjAppendElement() which knows about handling prefixes. * *------------------------------------------------------------------------- */ static inline void AppendWithPrefix( Tcl_Obj *result, /* Where to append a list element to. */ Tcl_DString *prefix, /* The prefix to add to the element, or NULL * for don't do that. */ const char *name, /* The name to append. */ int nameLen) /* The length of the name. May be -1 for * append-up-to-NUL-byte. */ { if (prefix) { int prefixLength = Tcl_DStringLength(prefix); Tcl_DStringAppend(prefix, name, nameLen); Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj( Tcl_DStringValue(prefix), Tcl_DStringLength(prefix))); Tcl_DStringSetLength(prefix, prefixLength); } else { Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(name, nameLen)); } } /* *------------------------------------------------------------------------- * * ZipFSMatchInDirectoryProc -- * * This routine is used by the globbing code to search a directory for * all files which match a given pattern. * * Results: * The return value is a standard Tcl result indicating whether an error * occurred in globbing. Errors are left in interp, good results are * lappend'ed to resultPtr (which must be a valid object). * * Side effects: * None. * *------------------------------------------------------------------------- */ static int ZipFSMatchInDirectoryProc( TCL_UNUSED(Tcl_Interp *), Tcl_Obj *result, /* Where to append matched items to. */ Tcl_Obj *pathPtr, /* Where we are looking. */ const char *pattern, /* What names we are looking for. */ Tcl_GlobTypeData *types) /* What types we are looking for. */ { Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); int scnt, l, dirOnly = -1, prefixLen, strip = 0, mounts = 0; int len; char *pat, *prefix, *path; Tcl_DString dsPref, *prefixBuf = NULL; if (!normPathPtr) { return -1; } if (types) { dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; mounts = (types->type == TCL_GLOB_TYPE_MOUNT); } /* * The prefix that gets prepended to results. */ prefix = TclGetStringFromObj(pathPtr, &prefixLen); /* * The (normalized) path we're searching. */ path = TclGetStringFromObj(normPathPtr, &len); Tcl_DStringInit(&dsPref); if (strcmp(prefix, path) == 0) { prefixBuf = NULL; } else { /* * We need to strip the normalized prefix of the filenames and replace * it with the official prefix that we were expecting to get. */ strip = len + 1; Tcl_DStringAppend(&dsPref, prefix, prefixLen); Tcl_DStringAppend(&dsPref, "/", 1); prefix = Tcl_DStringValue(&dsPref); prefixBuf = &dsPref; } ReadLock(); /* * Are we globbing the mount points? */ if (mounts) { ZipFSMatchMountPoints(result, normPathPtr, pattern, prefixBuf); goto end; } /* * Can we skip the complexity of actual globbing? Without a pattern, yes; * it's a directory existence test. */ if (!pattern || (pattern[0] == '\0')) { ZipEntry *z = ZipFSLookup(path); if (z && ((dirOnly < 0) || (!dirOnly && !z->isDirectory) || (dirOnly && z->isDirectory))) { AppendWithPrefix(result, prefixBuf, z->name, -1); } goto end; } /* * We've got to work for our supper and do the actual globbing. And all * we've got really is an undifferentiated pile of all the filenames we've * got from all our ZIP mounts. */ l = strlen(pattern); pat = (char *) Tcl_Alloc(len + l + 2); memcpy(pat, path, len); while ((len > 1) && (pat[len - 1] == '/')) { --len; } if ((len > 1) || (pat[0] != '/')) { pat[len] = '/'; ++len; } memcpy(pat + len, pattern, l + 1); scnt = CountSlashes(pat); for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory) || (!dirOnly && z->isDirectory))) { continue; } if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { AppendWithPrefix(result, prefixBuf, z->name + strip, -1); } } Tcl_Free(pat); end: Unlock(); Tcl_DStringFree(&dsPref); return TCL_OK; } /* *------------------------------------------------------------------------- * * ZipFSMatchMountPoints -- * * This routine is a worker for ZipFSMatchInDirectoryProc, used by the * globbing code to search for all mount points files which match a given * pattern. * * Results: * None. * * Side effects: * Adds the matching mounts to the list in result, uses prefix as working * space if it is non-NULL. * *------------------------------------------------------------------------- */ static void ZipFSMatchMountPoints( Tcl_Obj *result, /* The list of matches being built. */ Tcl_Obj *normPathPtr, /* Where we're looking from. */ const char *pattern, /* What we're looking for. NULL for a full * list. */ Tcl_DString *prefix) /* Workspace filled with a prefix for all the * filenames, or NULL if no prefix is to be * used. */ { Tcl_HashEntry *hPtr; Tcl_HashSearch search; int l, normLength; const char *path = TclGetStringFromObj(normPathPtr, &normLength); size_t len = (size_t) normLength; if (len < 1) { /* * Shouldn't happen. But "shouldn't"... */ return; } l = CountSlashes(path); if (path[len - 1] == '/') { len--; } else { l++; } if (!pattern || (pattern[0] == '\0')) { pattern = "*"; } for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (zf->mountPointLen == 0) { ZipEntry *z; /* * Enumerate the contents of the ZIP; it's mounted on the root. */ for (z = zf->topEnts; z; z = z->tnext) { size_t lenz = strlen(z->name); if ((lenz > len + 1) && (strncmp(z->name, path, len) == 0) && (z->name[len] == '/') && (CountSlashes(z->name) == l) && Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) { AppendWithPrefix(result, prefix, z->name, lenz); } } } else if ((zf->mountPointLen > len + 1) && (strncmp(zf->mountPoint, path, len) == 0) && (zf->mountPoint[len] == '/') && (CountSlashes(zf->mountPoint) == l) && Tcl_StringCaseMatch(zf->mountPoint + len + 1, pattern, 0)) { /* * Standard mount; append if it matches. */ AppendWithPrefix(result, prefix, zf->mountPoint, zf->mountPointLen); } } } /* *------------------------------------------------------------------------- * * ZipFSPathInFilesystemProc -- * * This function determines if the given path object is in the ZIP |
︙ | ︙ | |||
4295 4296 4297 4298 4299 4300 4301 | static int ZipFSPathInFilesystemProc( Tcl_Obj *pathPtr, TCL_UNUSED(ClientData *)) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; | | < < | > | | | 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 | static int ZipFSPathInFilesystemProc( Tcl_Obj *pathPtr, TCL_UNUSED(ClientData *)) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; int ret = -1, len; char *path; pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return -1; } path = TclGetStringFromObj(pathPtr, &len); if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) { return -1; } ReadLock(); hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); if (hPtr) { ret = TCL_OK; goto endloop; } for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (zf->mountPointLen == 0) { ZipEntry *z; for (z = zf->topEnts; z != NULL; z = z->tnext) { size_t lenz = strlen(z->name); if (((size_t) len >= lenz) && (strncmp(path, z->name, lenz) == 0)) { ret = TCL_OK; goto endloop; } } } else if (((size_t) len >= zf->mountPointLen) && (strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) { ret = TCL_OK; break; } } endloop: |
︙ | ︙ | |||
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 | * An array of strings * * Side effects: * None. * *------------------------------------------------------------------------- */ static const char *const * ZipFSFileAttrStringsProc( TCL_UNUSED(Tcl_Obj *) /*pathPtr*/, TCL_UNUSED(Tcl_Obj **) /*objPtrRef*/) { static const char *const attrs[] = { "-uncompsize", "-compsize", "-offset", "-mount", "-archive", "-permissions", NULL, }; return attrs; } /* | > > > > > > > > > > > > > > > | 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 | * An array of strings * * Side effects: * None. * *------------------------------------------------------------------------- */ enum ZipFileAttrs { ZIP_ATTR_UNCOMPSIZE, ZIP_ATTR_COMPSIZE, ZIP_ATTR_OFFSET, ZIP_ATTR_MOUNT, ZIP_ATTR_ARCHIVE, ZIP_ATTR_PERMISSIONS, ZIP_ATTR_CRC }; static const char *const * ZipFSFileAttrStringsProc( TCL_UNUSED(Tcl_Obj *) /*pathPtr*/, TCL_UNUSED(Tcl_Obj **) /*objPtrRef*/) { /* * Must match up with ZipFileAttrs enum above. */ static const char *const attrs[] = { "-uncompsize", "-compsize", "-offset", "-mount", "-archive", "-permissions", "-crc", NULL, }; return attrs; } /* |
︙ | ︙ | |||
4428 4429 4430 4431 4432 4433 4434 | static int ZipFSFileAttrsGetProc( Tcl_Interp *interp, /* Current interpreter. */ int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { | | | | | | | | | > > > > | 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 | static int ZipFSFileAttrsGetProc( Tcl_Interp *interp, /* Current interpreter. */ int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { int len, ret = TCL_OK; char *path; ZipEntry *z; pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return -1; } path = TclGetStringFromObj(pathPtr, &len); ReadLock(); z = ZipFSLookup(path); if (!z) { Tcl_SetErrno(ENOENT); ZIPFS_POSIX_ERROR(interp, "file not found"); ret = TCL_ERROR; goto done; } switch (index) { case ZIP_ATTR_UNCOMPSIZE: TclNewIntObj(*objPtrRef, z->numBytes); break; case ZIP_ATTR_COMPSIZE: TclNewIntObj(*objPtrRef, z->numCompressedBytes); break; case ZIP_ATTR_OFFSET: TclNewIntObj(*objPtrRef, z->offset); break; case ZIP_ATTR_MOUNT: *objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint, z->zipFilePtr->mountPointLen); break; case ZIP_ATTR_ARCHIVE: *objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, -1); break; case ZIP_ATTR_PERMISSIONS: *objPtrRef = Tcl_NewStringObj("0o555", -1); break; case ZIP_ATTR_CRC: TclNewIntObj(*objPtrRef, z->crc32); break; default: ZIPFS_ERROR(interp, "unknown attribute"); ZIPFS_ERROR_CODE(interp, "FILE_ATTR"); ret = TCL_ERROR; } done: Unlock(); return ret; } |
︙ | ︙ | |||
4499 4500 4501 4502 4503 4504 4505 | static int ZipFSFileAttrsSetProc( Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*index*/, TCL_UNUSED(Tcl_Obj *) /*pathPtr*/, TCL_UNUSED(Tcl_Obj *) /*objPtr*/) { | < | | < | 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 | static int ZipFSFileAttrsSetProc( Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*index*/, TCL_UNUSED(Tcl_Obj *) /*pathPtr*/, TCL_UNUSED(Tcl_Obj *) /*objPtr*/) { ZIPFS_ERROR(interp, "unsupported operation"); ZIPFS_ERROR_CODE(interp, "UNSUPPORTED_OP"); return TCL_ERROR; } /* *------------------------------------------------------------------------- * * ZipFSFilesystemPathTypeProc -- |
︙ | ︙ | |||
4604 4605 4606 4607 4608 4609 4610 | * [file dirname [info nameofexecutable]] is equal to [info * nameofexecutable] due to VFS effects. */ if (execName) { const char *p = strrchr(execName, '/'); | | | 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 | * [file dirname [info nameofexecutable]] is equal to [info * nameofexecutable] due to VFS effects. */ if (execName) { const char *p = strrchr(execName, '/'); if (p && p > execName + 1) { --p; objs[0] = Tcl_NewStringObj(execName, p - execName); } } if (!objs[0]) { objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(), TCL_PATH_DIRNAME); |
︙ | ︙ | |||
4630 4631 4632 4633 4634 4635 4636 | if (objs[0]) { Tcl_DecrRefCount(objs[0]); } if (objs[1]) { Tcl_DecrRefCount(objs[1]); } | | > | 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 | if (objs[0]) { Tcl_DecrRefCount(objs[0]); } if (objs[1]) { Tcl_DecrRefCount(objs[1]); } loadFileProc = (Tcl_FSLoadFileProc2 *) (void *) tclNativeFilesystem.loadFileProc; if (loadFileProc) { ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } else { Tcl_SetErrno(ENOENT); ZIPFS_ERROR(interp, Tcl_PosixError(interp)); } if (altPath) { |
︙ | ︙ | |||
4719 4720 4721 4722 4723 4724 4725 | Unlock(); if (interp) { Tcl_Command ensemble; Tcl_Obj *mapObj; Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL); | > | | > > > | | > | 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 | Unlock(); if (interp) { Tcl_Command ensemble; Tcl_Obj *mapObj; Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL); if (!Tcl_IsSafe(interp)) { Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax, TCL_LINK_INT); Tcl_LinkVar(interp, "::tcl::zipfs::fallbackEntryEncoding", (char *) &ZipFS.fallbackEntryEncoding, TCL_LINK_STRING); } ensemble = TclMakeEnsemble(interp, "zipfs", Tcl_IsSafe(interp) ? (initMap + 4) : initMap); /* * Add the [zipfs find] subcommand. */ Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj); Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1), Tcl_NewStringObj("::tcl::zipfs::find", -1)); Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init", ZipFSTclLibraryObjCmd, NULL, NULL); Tcl_PkgProvide(interp, "tcl::zipfs", "2.0"); } return TCL_OK; #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; |
︙ | ︙ | |||
4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 | if (found == 0) { zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library"; return TCL_OK; } return TCL_ERROR; } static void ZipfsExitHandler( ClientData clientData) { | > | | | > | | | | 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 | if (found == 0) { zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library"; return TCL_OK; } 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"); } } /* *------------------------------------------------------------------------- * * 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 *result; #ifdef _WIN32 result = Tcl_FindExecutable(NULL); #else result = Tcl_FindExecutable((*argvPtr)[0]); #endif archive = Tcl_GetNameOfExecutable(); TclZipfs_Init(NULL); /* * Look for init.tcl in one of the locations mounted later in this * function. */ |
︙ | ︙ | |||
4857 4858 4859 4860 4861 4862 4863 | 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"; | | | 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 | 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 result; } } #ifdef SUPPORT_BUILTIN_ZIP_INSTALL } else if (*argcPtr > 1) { /* * If the first argument is "install", run the supplied installer * script. |
︙ | ︙ | |||
4890 4891 4892 4893 4894 4895 4896 | 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); } | | | 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 | 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 result; } 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) { |
︙ | ︙ | |||
4914 4915 4916 4917 4918 4919 4920 | 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"; | | | | 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 | 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 result; } } #ifdef _WIN32 Tcl_DStringFree(&ds); #endif /* _WIN32 */ #endif /* SUPPORT_BUILTIN_ZIP_INSTALL */ } return result; } #ifndef HAVE_ZLIB /* *------------------------------------------------------------------------- * |
︙ | ︙ | |||
4946 4947 4948 4949 4950 4951 4952 | Tcl_Interp *interp, /* Current interpreter. */ const char *mountPoint, /* Mount point path. */ const char *zipname, /* Path to ZIP file to mount. */ const char *passwd) /* Password for opening the ZIP, or NULL if * the ZIP is unprotected. */ { ZIPFS_ERROR(interp, "no zlib available"); | | < < | < < | < < | 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 | Tcl_Interp *interp, /* Current interpreter. */ const char *mountPoint, /* Mount point path. */ const char *zipname, /* Path to ZIP file to mount. */ const char *passwd) /* 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. */ const char *mountPoint, /* Mount point path. */ unsigned char *data, size_t datalen, int copy) { ZIPFS_ERROR(interp, "no zlib available"); ZIPFS_ERROR_CODE(interp, "NO_ZLIB"); return TCL_ERROR; } int TclZipfs_Unmount( Tcl_Interp *interp, /* Current interpreter. */ const char *mountPoint) /* Mount point path. */ { ZIPFS_ERROR(interp, "no zlib available"); ZIPFS_ERROR_CODE(interp, "NO_ZLIB"); return TCL_ERROR; } #endif /* !HAVE_ZLIB */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclZlib.c.
1 2 3 4 5 | /* * tclZlib.c -- * * This file provides the interface to the Zlib library. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclZlib.c -- * * This file provides the interface to the Zlib library. * * Copyright © 2004-2005 Pascal Scheffers <[email protected]> * Copyright © 2005 Unitas Software B.V. * Copyright © 2008-2012 Donal K. Fellows * * Parts written by Jean-Claude Wippler, as part of Tclkit, placed in the * public domain March 2003. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ |
︙ | ︙ | |||
439 440 441 442 443 444 445 | if (latin1enc == NULL) { Tcl_Panic("no latin-1 encoding"); } if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { | | | | 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 | if (latin1enc == NULL) { Tcl_Panic("no latin-1 encoding"); } if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { valueStr = Tcl_GetStringFromObj(value, &length); Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, NULL); headerPtr->nativeCommentBuf[len] = '\0'; headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf; if (extraSizePtr != NULL) { *extraSizePtr += len; } } if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) { goto error; } else if (value != NULL && Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) { goto error; } if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) { goto error; } else if (value != NULL) { valueStr = Tcl_GetStringFromObj(value, &length); Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL, headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL); headerPtr->nativeFilenameBuf[len] = '\0'; headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf; if (extraSizePtr != NULL) { *extraSizePtr += len; } |
︙ | ︙ | |||
591 592 593 594 595 596 597 | static int SetInflateDictionary( z_streamp strm, Tcl_Obj *compDictObj) { if (compDictObj != NULL) { size_t length = 0; | | | | 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 | static int SetInflateDictionary( z_streamp strm, Tcl_Obj *compDictObj) { if (compDictObj != NULL) { size_t length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); return inflateSetDictionary(strm, bytes, length); } return Z_OK; } static int SetDeflateDictionary( z_streamp strm, Tcl_Obj *compDictObj) { if (compDictObj != NULL) { size_t length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); return deflateSetDictionary(strm, bytes, length); } return Z_OK; } static inline int |
︙ | ︙ | |||
1382 1383 1384 1385 1386 1387 1388 | * under our feet. [Bug 3081008] */ Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj); if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } | | | 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 | * under our feet. [Bug 3081008] */ Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj); if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; zshPtr->stream.avail_in = itemLen; /* * And remove it from the list |
︙ | ︙ | |||
1454 1455 1456 1457 1458 1459 1460 | * representation to not vanish under our feet. [Bug 3081008] */ Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj); if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } | | | 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 | * representation to not vanish under our feet. [Bug 3081008] */ Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj); if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; zshPtr->stream.avail_in = itemLen; /* * Remove it from the list. |
︙ | ︙ | |||
1503 1504 1505 1506 1507 1508 1509 | } } else { Tcl_ListObjLength(NULL, zshPtr->outData, &listLen); if (count == TCL_INDEX_NONE) { count = 0; for (i=0; i<listLen; i++) { Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj); | | | 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 | } } else { Tcl_ListObjLength(NULL, zshPtr->outData, &listLen); if (count == TCL_INDEX_NONE) { 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; } else { count += itemLen; } } } |
︙ | ︙ | |||
1528 1529 1530 1531 1532 1533 1534 | && (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); | | | 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 | && (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); itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); if (itemLen-zshPtr->outPos + dataPos >= count) { size_t len = count - dataPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); zshPtr->outPos += len; dataPos += len; if (zshPtr->outPos == itemLen) { |
︙ | ︙ | |||
3477 3478 3479 3480 3481 3482 3483 | TclGetString(cd->compDictObj)); } else { Tcl_DStringAppendElement(dsPtr, ""); } } else { if (cd->compDictObj) { size_t length; | | | 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 | TclGetString(cd->compDictObj)); } else { Tcl_DStringAppendElement(dsPtr, ""); } } else { if (cd->compDictObj) { size_t length; const char *str = Tcl_GetStringFromObj(cd->compDictObj, &length); Tcl_DStringAppend(dsPtr, str, length); } return TCL_OK; } } |
︙ | ︙ | |||
3717 3718 3719 3720 3721 3722 3723 | cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; } } if (compDictObj != NULL) { cd->compDictObj = Tcl_DuplicateObj(compDictObj); Tcl_IncrRefCount(cd->compDictObj); | | | 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 | cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; } } if (compDictObj != NULL) { cd->compDictObj = Tcl_DuplicateObj(compDictObj); Tcl_IncrRefCount(cd->compDictObj); TclGetByteArrayFromObj(cd->compDictObj, NULL); } if (format == TCL_ZLIB_FORMAT_RAW) { wbits = WBITS_RAW; } else if (format == TCL_ZLIB_FORMAT_ZLIB) { wbits = WBITS_ZLIB; } else if (format == TCL_ZLIB_FORMAT_GZIP) { |
︙ | ︙ | |||
3965 3966 3967 3968 3969 3970 3971 | TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream"); /* * Formally provide the package as a Tcl built-in. */ | > | > > | 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 | TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream"); /* * Formally provide the package as a Tcl built-in. */ #if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL); #endif return Tcl_PkgProvideEx(interp, "tcl::zlib", TCL_ZLIB_VERSION, NULL); } /* *---------------------------------------------------------------------- * Stubs used when a suitable zlib installation was not found during * configure. *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to library/auto.tcl.
1 2 3 4 5 | # auto.tcl -- # # utility procs formerly in init.tcl dealing with auto execution of commands # and can be auto loaded themselves. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # auto.tcl -- # # utility procs formerly in init.tcl dealing with auto execution of commands # and can be auto loaded themselves. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # auto_reset -- # |
︙ | ︙ | |||
66 67 68 69 70 71 72 | } else { # Do the canonical search # 1. From an environment variable, if it exists. Placing this first # gives the end-user ultimate control to work-around any bugs, or # to customize. | | | | | | | | | | | | | | | | | | | | | | | | > | > | > | > > > > | < | | | > > | | | > > | | | | | | | | | | | | | | | | | 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 | } else { # Do the canonical search # 1. From an environment variable, if it exists. Placing this first # gives the end-user ultimate control to work-around any bugs, or # to customize. if {[info exists env($enVarName)]} { lappend dirs $env($enVarName) } catch { set found 0 set root [zipfs root] set mountpoint [file join $root lib $basename] lappend dirs [file join $root app ${basename}_library] lappend dirs [file join $root lib $mountpoint ${basename}_library] lappend dirs [file join $root lib $mountpoint] if {![zipfs exists [file join $root app ${basename}_library]] \ && ![zipfs exists $mountpoint]} { set found 0 foreach pkgdat [info loaded] { lassign $pkgdat dllfile dllpkg if {$dllpkg ne $basename} continue if {$dllfile eq {}} { # Loaded statically break } set found 1 zipfs mount $mountpoint $dllfile break } if {!$found} { set paths {} if {![catch {::${basename}::pkgconfig get libdir,runtime} dir]} { lappend paths $dir } else { catch {lappend paths [::tcl::pkgconfig get libdir,runtime]} } if {![catch {::${basename}::pkgconfig get bindir,runtime} dir]} { lappend paths $dir } else { catch {lappend paths [::tcl::pkgconfig get bindir,runtime]} } if {[catch {::${basename}::pkgconfig get dllfile,runtime} dllfile]} { set dllfile "lib${basename}${version}[info sharedlibextension]" } set dir [file dirname [file join [pwd] [info nameofexecutable]]] lappend paths $dir lappend paths [file join [file dirname $dir] lib] foreach path $paths { set archive [file join $path $dllfile] if {![file exists $archive]} { continue } zipfs mount $mountpoint $archive if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} { lappend dirs [file join $mountpoint ${basename}_library] set found 1 break } elseif {[zipfs exists [file join $mountpoint $initScript]]} { lappend dirs [file join $mountpoint $initScript] set found 1 break } else { catch {zipfs unmount $archive} } } } } } # 2. In the package script directory registered within the # configuration of the package itself. catch { lappend dirs [::${basename}::pkgconfig get scriptdir,runtime] } |
︙ | ︙ | |||
154 155 156 157 158 159 160 | # # ../../library (From unix/arch directory in build hierarchy) # ../../foo1.0.1/library # (From unix directory in parallel build hierarchy) # ../../../foo1.0.1/library # (From unix/arch directory in parallel build hierarchy) | | | | | | | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | # # ../../library (From unix/arch directory in build hierarchy) # ../../foo1.0.1/library # (From unix directory in parallel build hierarchy) # ../../../foo1.0.1/library # (From unix/arch directory in parallel build hierarchy) set parentDir [file dirname [file dirname [info nameofexecutable]]] set grandParentDir [file dirname $parentDir] lappend dirs [file join $parentDir lib $basename$version] lappend dirs [file join $grandParentDir lib $basename$version] lappend dirs [file join $parentDir library] if {0} { lappend dirs [file join $grandParentDir library] lappend dirs [file join $grandParentDir $basename$patch library] lappend dirs [file join [file dirname $grandParentDir] \ $basename$patch library] } } |
︙ | ︙ | |||
181 182 183 184 185 186 187 | set norm [file normalize $i] } if {[info exists seen($norm)]} { continue } set seen($norm) {} | | | | | | | | | 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 | set norm [file normalize $i] } if {[info exists seen($norm)]} { continue } set seen($norm) {} set the_library $i set file [file join $i $initScript] # source everything when in a safe interpreter because we have a # source command, but no file exists command if {[interp issafe] || [file exists $file]} { if {![catch {uplevel #0 [list source $file]} msg opts]} { return } append errors "$file: $msg\n" append errors [dict get $opts -errorinfo]\n } } unset -nocomplain the_library set msg "Can't find a usable $initScript in the following directories: \n" append msg " $dirs\n\n" append msg "$errors\n\n" append msg "This probably means that $basename wasn't installed properly.\n" error $msg |
︙ | ︙ | |||
232 233 234 235 236 237 238 | # args - Any number of additional arguments giving the names of files # within dir. If no additional are given auto_mkindex will look # for *.tcl. proc auto_mkindex {dir args} { if {[interp issafe]} { | | | 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 | # args - Any number of additional arguments giving the names of files # within dir. If no additional are given auto_mkindex will look # for *.tcl. proc auto_mkindex {dir args} { if {[interp issafe]} { error "can't generate index within safe interpreter" } set oldDir [pwd] cd $dir append index "# Tcl autoload index file, version 2.0\n" append index "# This file is generated by the \"auto_mkindex\" command\n" |
︙ | ︙ | |||
288 289 290 291 292 293 294 | if {![llength $args]} { set args *.tcl } foreach file [lsort [glob -- {*}$args]] { set f "" set error [catch { set f [open $file] | | | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 | if {![llength $args]} { set args *.tcl } foreach file [lsort [glob -- {*}$args]] { set f "" set error [catch { set f [open $file] fconfigure $f -encoding utf-8 -eofchar "\032 {}" while {[gets $f line] >= 0} { if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} { set procName [lindex [auto_qualify $procName "::"] 0] append index "set [list auto_index($procName)]" append index " \[list source \[file join \$dir [list $file]\]\]\n" } } |
︙ | ︙ | |||
400 401 402 403 404 405 406 | variable scriptFile variable contextStack variable imports set scriptFile $file set fid [open $file] | | | | 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 | variable scriptFile variable contextStack variable imports set scriptFile $file set fid [open $file] fconfigure $fid -encoding utf-8 -eofchar "\032 {}" set contents [read $fid] close $fid # There is one problem with sourcing files into the safe interpreter: # references like "$x" will fail since code is not really being executed # and variables do not really exist. To avoid this, we replace all $ with # \0 (literally, the null char) later, when getting proc names we will # have to reverse this replacement, in case there were any $ in the proc # name. This will cause a problem if somebody actually tries to have a \0 # in their proc name. Too bad for them. set contents [string map [list \$ \0] $contents] set index "" set contextStack "" set imports "" $parser eval $contents foreach name $imports { catch {$parser eval [list _%@namespace forget $name]} } return $index } # auto_mkindex_parser::hook command # # Registers a Tcl command to evaluate when initializing the child interpreter |
︙ | ︙ | |||
490 491 492 493 494 495 496 | proc auto_mkindex_parser::commandInit {name arglist body} { variable parser set ns [namespace qualifiers $name] set tail [namespace tail $name] if {$ns eq ""} { | | | | | | | | | | 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 | proc auto_mkindex_parser::commandInit {name arglist body} { variable parser set ns [namespace qualifiers $name] set tail [namespace tail $name] if {$ns eq ""} { set fakeName [namespace current]::_%@fake_$tail } else { set fakeName [namespace current]::[string map {:: _} _%@fake_$name] } proc $fakeName $arglist $body # YUK! Tcl won't let us alias fully qualified command names, so we can't # handle names like "::itcl::class". Instead, we have to build procs with # the fully qualified names, and have the procs point to the aliases. if {[string match *::* $name]} { set exportCmd [list _%@namespace export [namespace tail $name]] $parser eval [list _%@namespace eval $ns $exportCmd] # The following proc definition does not work if you want to tolerate # space or something else diabolical in the procedure name, (i.e., # space in $alias). The following does not work: # "_%@eval {$alias} \$args" # because $alias gets concat'ed to $args. The following does not work # because $cmd is somehow undefined # "set cmd {$alias} \; _%@eval {\$cmd} \$args" # A gold star to someone that can make test autoMkindex-3.3 work # properly set alias [namespace tail $fakeName] $parser invokehidden proc $name {args} "_%@eval {$alias} \$args" $parser alias $alias $fakeName } else { $parser alias $name $fakeName } return } # auto_mkindex_parser::fullname -- # # Used by commands like "proc" within the auto_mkindex parser. Returns the |
︙ | ︙ | |||
540 541 542 543 544 545 546 | # Arguments: # name - Name that is being added to index. proc auto_mkindex_parser::fullname {name} { variable contextStack if {![string match ::* $name]} { | | | | | | | | | | 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 | # Arguments: # name - Name that is being added to index. proc auto_mkindex_parser::fullname {name} { variable contextStack if {![string match ::* $name]} { foreach ns $contextStack { set name "${ns}::$name" if {[string match ::* $name]} { break } } } if {[namespace qualifiers $name] eq ""} { set name [namespace tail $name] } elseif {![string match ::* $name]} { set name "::$name" } # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse that # replacement. return [string map [list \0 \$] $name] } |
︙ | ︙ | |||
641 642 643 644 645 646 647 | # for any commands contained in a namespace that affect the index. For # example, a script may say "itcl::class ...", or it may import "itcl::*" and # then say "class ...". This procedure does the import operation, but keeps # track of imported patterns so we can remove the imports later. auto_mkindex_parser::command namespace {op args} { switch -- $op { | | | | | | | | | | | | | | | | | | | | 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 | # for any commands contained in a namespace that affect the index. For # example, a script may say "itcl::class ...", or it may import "itcl::*" and # then say "class ...". This procedure does the import operation, but keeps # track of imported patterns so we can remove the imports later. auto_mkindex_parser::command namespace {op args} { switch -- $op { eval { variable parser variable contextStack set name [lindex $args 0] set args [lrange $args 1 end] set contextStack [linsert $contextStack 0 $name] $parser eval [list _%@namespace eval $name] $args set contextStack [lrange $contextStack 1 end] } import { variable parser variable imports foreach pattern $args { if {$pattern ne "-force"} { lappend imports $pattern } } catch {$parser eval "_%@namespace import $args"} } ensemble { variable parser variable contextStack if {[lindex $args 0] eq "create"} { set name ::[join [lreverse $contextStack] ::] catch { set name [dict get [lrange $args 1 end] -command] |
︙ | ︙ |
Changes to library/clock.tcl.
1 2 3 4 5 6 7 8 9 10 11 | #---------------------------------------------------------------------- # # clock.tcl -- # # This file implements the portions of the [clock] ensemble that are # coded in Tcl. Refer to the users' manual to see the description of # the [clock] command and its subcommands. # # #---------------------------------------------------------------------- # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | #---------------------------------------------------------------------- # # clock.tcl -- # # This file implements the portions of the [clock] ensemble that are # coded in Tcl. Refer to the users' manual to see the description of # the [clock] command and its subcommands. # # #---------------------------------------------------------------------- # # Copyright © 2004-2007 Kevin B. Kenny # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # #---------------------------------------------------------------------- # We must have message catalogs that support the root locale, and we need # access to the Registry on Windows systems. |
︙ | ︙ | |||
2984 2985 2986 2987 2988 2989 2990 | variable CachedSystemTimeZone variable TimeZoneBad if {[set result [getenv TCL_TZ]] ne {}} { set timezone $result } elseif {[set result [getenv TZ]] ne {}} { set timezone $result | | < | 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 | variable CachedSystemTimeZone variable TimeZoneBad if {[set result [getenv TCL_TZ]] ne {}} { set timezone $result } elseif {[set result [getenv TZ]] ne {}} { set timezone $result } else { # Cache the time zone only if it was detected by one of the # expensive methods. if { [info exists CachedSystemTimeZone] } { set timezone $CachedSystemTimeZone } elseif { $::tcl_platform(platform) eq {windows} } { set timezone [GuessWindowsTimeZone] } elseif { [file exists /etc/localtime] |
︙ | ︙ |
Changes to library/cookiejar/cookiejar.tcl.
︙ | ︙ | |||
128 129 130 131 132 133 134 | # Now we have enough information to provide the package. package provide cookiejar \ [set [info object namespace ::http::cookiejar]::version] # The implementation of the cookiejar package ::oo::define ::http::cookiejar { self { | | | | | 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 | # Now we have enough information to provide the package. package provide cookiejar \ [set [info object namespace ::http::cookiejar]::version] # The implementation of the cookiejar package ::oo::define ::http::cookiejar { self { method configure {{optionName "\x00\x00"} {optionValue "\x00\x00"}} { set tbl { -domainfile {domainfile set} -domainlist {domainlist set} -domainrefresh {refreshinterval setInterval} -loglevel {loglevel setLog} -offline {offline setBool} -purgeold {purgeinterval setInterval} -retain {retainlimit setInt} -vacuumtrigger {vacuumtrigger setInt} } dict lappend tbl -domainrefresh [namespace code { my IntervalTrigger PostponeRefresh }] dict lappend tbl -purgeold [namespace code { my IntervalTrigger PostponePurge }] if {$optionName eq "\x00\x00"} { return [dict keys $tbl] } set opt [::tcl::prefix match -message "option" \ [dict keys $tbl] $optionName] set setter [lassign [dict get $tbl $opt] varname] namespace upvar [namespace current] $varname var if {$optionValue ne "\x00\x00"} { {*}$setter var $optionValue } return $var } method IntervalTrigger {method} { # TODO: handle subclassing |
︙ | ︙ |
Changes to library/cookiejar/idna.tcl.
1 2 3 4 5 6 7 8 9 | # cookiejar.tcl -- # # Implementation of IDNA (Internationalized Domain Names for # Applications) encoding/decoding system, built on a punycode engine # developed directly from the code in RFC 3492, Appendix C (with # substantial modifications). # # This implementation includes code from that RFC, translated to Tcl; the # other parts are: | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # cookiejar.tcl -- # # Implementation of IDNA (Internationalized Domain Names for # Applications) encoding/decoding system, built on a punycode engine # developed directly from the code in RFC 3492, Appendix C (with # substantial modifications). # # This implementation includes code from that RFC, translated to Tcl; the # other parts are: # Copyright © 2014 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. namespace eval ::tcl::idna { namespace ensemble create -command puny -map { encode punyencode decode punydecode } namespace ensemble create -command ::tcl::idna -map { encode IDNAencode decode IDNAdecode puny puny version {::apply {{} {package present tcl::idna} ::}} } proc IDNAencode hostname { set parts {} # Split term from RFC 3490, Sec 3.1 foreach part [split $hostname "\x2E\u3002\uFF0E\uFF61"] { if {[regexp {[^-A-Za-z0-9]} $part]} { if {[regexp {[^-A-Za-z0-9\xA1-\uFFFF]} $part ch]} { scan $ch %c c if {$ch < "!" || $ch > "~"} { set ch [format "\\u%04x" $c] } throw [list IDNA INVALID_NAME_CHARACTER $ch] \ "bad character \"$ch\" in DNS name" } |
︙ | ︙ | |||
47 48 49 50 51 52 53 | lappend parts $part } return [join $parts .] } proc IDNAdecode hostname { set parts {} # Split term from RFC 3490, Sec 3.1 | | | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | lappend parts $part } return [join $parts .] } proc IDNAdecode hostname { set parts {} # Split term from RFC 3490, Sec 3.1 foreach part [split $hostname "\x2E\u3002\uFF0E\uFF61"] { if {[string match -nocase "xn--*" $part]} { set part [punydecode [string range $part 4 end]] } lappend parts $part } return [join $parts .] } |
︙ | ︙ | |||
112 113 114 115 116 117 118 | # Initialize the state: set n $initial_n set delta 0 set bias $initial_bias # Handle the basic code points: foreach ch $string { | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | # Initialize the state: set n $initial_n set delta 0 set bias $initial_bias # Handle the basic code points: foreach ch $string { if {$ch < "\x80"} { if {$case eq ""} { append output $ch } elseif {[string is true $case]} { append output [string toupper $ch] } elseif {[string is false $case]} { append output [string tolower $ch] } |
︙ | ︙ |
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] } |
Changes to library/history.tcl.
1 2 3 4 | # history.tcl -- # # Implementation of the history command. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 | # history.tcl -- # # Implementation of the history command. # # Copyright © 1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # The tcl::history array holds the history list and some additional # bookkeeping variables. |
︙ | ︙ |
Changes to library/init.tcl.
1 2 3 4 5 | # init.tcl -- # # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # init.tcl -- # # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2004 Kevin B. Kenny. # Copyright © 2018 Sean Woods # # All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # This test intentionally written in pre-7.5 Tcl if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } package require -exact tcl 9.0a2 # 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. |
︙ | ︙ | |||
438 439 440 441 442 443 444 | set f "" if {$issafe} { catch {source [file join $dir tclIndex]} } elseif {[catch {set f [open [file join $dir tclIndex]]}]} { continue } else { set error [catch { | | | 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 | set f "" if {$issafe} { catch {source [file join $dir tclIndex]} } elseif {[catch {set f [open [file join $dir tclIndex]]}]} { continue } else { set error [catch { fconfigure $f -encoding utf-8 -eofchar "\032 {}" set id [gets $f] if {$id eq "# Tcl autoload index file, version 2.0"} { eval [read $f] } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} { while {[gets $f line] >= 0} { if {([string index $line 0] eq "#") \ || ([llength $line] != 2)} { |
︙ | ︙ |
Changes to library/install.tcl.
︙ | ︙ | |||
31 32 33 34 35 36 37 | ### set package [lindex [split $fname -] 0] set version [lindex [split $fname -] 1] ### # Read the file, and override assumptions as needed ### set fin [open $file r] | | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | ### set package [lindex [split $fname -] 0] set version [lindex [split $fname -] 1] ### # Read the file, and override assumptions as needed ### set fin [open $file r] fconfigure $fin -encoding utf-8 -eofchar "\032 {}" set dat [read $fin] close $fin # Look for a teapot style Package statement foreach line [split $dat \n] { set line [string trim $line] if { [string range $line 0 9] != "# Package " } continue set package [lindex $line 2] |
︙ | ︙ | |||
55 56 57 58 59 60 61 | break } append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n } foreach file [glob -nocomplain $path/*.tcl] { if { [file tail $file] == "version_info.tcl" } continue set fin [open $file r] | | | | 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 | break } append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n } foreach file [glob -nocomplain $path/*.tcl] { if { [file tail $file] == "version_info.tcl" } continue set fin [open $file r] fconfigure $fin -encoding utf-8 -eofchar "\032 {}" set dat [read $fin] close $fin if {![regexp "package provide" $dat]} continue set fname [file rootname [file tail $file]] # Look for a package provide statement foreach line [split $dat \n] { set line [string trim $line] if { [string range $line 0 14] != "package provide" } continue set package [lindex $line 2] set version [lindex $line 3] if {[string index $package 0] in "\$ \[ @"} continue if {[string index $version 0] in "\$ \[ @"} continue append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n break } } return $buffer } set fin [open $pkgidxfile r] fconfigure $fin -encoding utf-8 -eofchar "\032 {}" set dat [read $fin] close $fin set trace 0 #if {[file tail $path] eq "tool"} { # set trace 1 #} set thisline {} |
︙ | ︙ | |||
198 199 200 201 202 203 204 | foreach ftail [glob -directory $d1 -nocomplain -tails *] { set f [file join $d1 $ftail] if {[file isdirectory $f] && [string compare CVS $ftail]} { installDir $f [file join $d2 $ftail] } elseif {[file isfile $f]} { file copy -force $f [file join $d2 $ftail] if {$::tcl_platform(platform) eq {unix}} { | | | | 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 | foreach ftail [glob -directory $d1 -nocomplain -tails *] { set f [file join $d1 $ftail] if {[file isdirectory $f] && [string compare CVS $ftail]} { installDir $f [file join $d2 $ftail] } elseif {[file isfile $f]} { file copy -force $f [file join $d2 $ftail] if {$::tcl_platform(platform) eq {unix}} { file attributes [file join $d2 $ftail] -permissions 0o644 } else { file attributes [file join $d2 $ftail] -readonly 1 } } } if {$::tcl_platform(platform) eq {unix}} { file attributes $d2 -permissions 0o755 } else { file attributes $d2 -readonly 1 } } proc ::practcl::copyDir {d1 d2 {toplevel 1}} { #if {$toplevel} { |
︙ | ︙ |
Changes to library/manifest.txt.
1 2 3 4 5 6 7 8 9 10 11 12 | ### # 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.10.0a1 {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} | | | | 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.10.0a1 {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.17 {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/msgcat/msgcat.tcl.
1 2 3 4 5 6 | # msgcat.tcl -- # # This file defines various procedures which implement a # message catalog facility for Tcl programs. It should be # loaded with the command "package require msgcat". # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # msgcat.tcl -- # # This file defines various procedures which implement a # message catalog facility for Tcl programs. It should be # loaded with the command "package require msgcat". # # Copyright © 2010-2018 Harald Oehlmann. # Copyright © 1998-2000 Ajuba Solutions. # Copyright © 1998 Mark Harrison. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # We use oo::define::self, which is new in Tcl 8.7 package require Tcl 8.7- # When the version number changes, be sure to update the pkgIndex.tcl file, |
︙ | ︙ |
Changes to library/opt/optparse.tcl.
︙ | ︙ | |||
597 598 599 600 601 602 603 | if {![string is boolean -strict $arg]} { error "non canonic boolean" } # convert true/false because expr/if is broken with "!,... return [expr {$arg ? 1 : 0}] } choice { | | | 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 | if {![string is boolean -strict $arg]} { error "non canonic boolean" } # convert true/false because expr/if is broken with "!,... return [expr {$arg ? 1 : 0}] } choice { if {$arg ni $typeArgs} { error "invalid choice" } return $arg } any { return $arg } |
︙ | ︙ |
Changes to library/package.tcl.
1 2 3 4 5 | # package.tcl -- # # utility procs formerly in init.tcl which can be loaded on demand # for package management. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # package.tcl -- # # utility procs formerly in init.tcl which can be loaded on demand # for package management. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # namespace eval tcl::Pkg {} |
︙ | ︙ |
Changes to library/parray.tcl.
1 2 3 | # parray: # Print the contents of a global array on stdout. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 | # parray: # Print the contents of a global array on stdout. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # proc parray {a {pattern *}} { upvar 1 $a array |
︙ | ︙ |
Changes to library/platform/pkgIndex.tcl.
|
| | | 1 2 3 | package ifneeded platform 1.0.17 [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.
︙ | ︙ | |||
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | # result. # # General # Only the first element of 'os' is used - we don't care whether we # are on "Windows NT" or "Windows XP" or whatever. # # Machine specific # % arm* -> arm # % sun4* -> sparc # % intel -> ix86 # % i*86* -> ix86 # % Power* -> powerpc # % x86_64 + wordSize 4 => x86 code # # OS specific # % AIX are always powerpc machines | > > | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | # result. # # General # Only the first element of 'os' is used - we don't care whether we # are on "Windows NT" or "Windows XP" or whatever. # # Machine specific # % amd64 -> x86_64 # % arm* -> arm # % sun4* -> sparc # % ia32* -> ix86 # % intel -> ix86 # % i*86* -> ix86 # % Power* -> powerpc # % x86_64 + wordSize 4 => x86 code # # OS specific # % AIX are always powerpc machines |
︙ | ︙ | |||
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 | set cpu $tcl_platform(machine) switch -glob -- $cpu { sun4* { set cpu sparc } intel - i*86* { set cpu ix86 } x86_64 { if {$tcl_platform(wordSize) == 4} { # See Example <1> at the top of this file. set cpu ix86 } } "Power*" { set cpu powerpc } "arm*" { set cpu arm } ia64 { if {$tcl_platform(wordSize) == 4} { append cpu _32 } } } switch -glob -- $plat { | > > < < < | 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 | set cpu $tcl_platform(machine) switch -glob -- $cpu { sun4* { set cpu sparc } intel - ia32* - i*86* { set cpu ix86 } x86_64 { if {$tcl_platform(wordSize) == 4} { # See Example <1> at the top of this file. set cpu ix86 } } ppc - "Power*" { set cpu powerpc } "arm*" { set cpu arm } ia64 { if {$tcl_platform(wordSize) == 4} { append cpu _32 } } } switch -glob -- $plat { windows { if {$tcl_platform(platform) == "unix"} { set plat cygwin } else { set plat win32 } if {$cpu eq "amd64"} { |
︙ | ︙ | |||
145 146 147 148 149 150 151 152 153 154 155 156 157 158 | append cpu 64 } } } osf1 { set plat tru64 } } return "${plat}-${cpu}" } # -- platform::identify # | > > > | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | append cpu 64 } } } osf1 { set plat tru64 } default { set plat [lindex [split $plat _-] 0] } } return "${plat}-${cpu}" } # -- platform::identify # |
︙ | ︙ | |||
171 172 173 174 175 176 177 | solaris { regsub {^5} $tcl_platform(osVersion) 2 text append plat $text return "${plat}-${cpu}" } macosx { set major [lindex [split $tcl_platform(osVersion) .] 0] | | > > > > > | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | solaris { regsub {^5} $tcl_platform(osVersion) 2 text append plat $text return "${plat}-${cpu}" } macosx { set major [lindex [split $tcl_platform(osVersion) .] 0] if {$major > 19} { set minor [lindex [split $tcl_platform(osVersion) .] 1] incr major -9 append plat $major.[expr {$minor - 1}] } else { incr major -4 append plat 10.$major return "${plat}-${cpu}" } return "${plat}-${cpu}" } linux { # Look for the libc*.so and determine its version # (libc5/6, libc6 further glibc 2.X) set v unknown |
︙ | ︙ | |||
326 327 328 329 330 331 332 | macosx-x86_64 { lappend res macosx-i386-x86_64 } macosx-ix86 { lappend res macosx-universal macosx-i386-x86_64 } macosx*-* { | | | > > > > > > > > > < > > > > > > > > > > > > > | > | 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 | macosx-x86_64 { lappend res macosx-i386-x86_64 } macosx-ix86 { lappend res macosx-universal macosx-i386-x86_64 } macosx*-* { # 10.5+,11.0+ if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} { switch -exact -- $cpu { ix86 { lappend alt i386-x86_64 lappend alt universal } x86_64 { if {[lindex [split $::tcl_platform(osVersion) .] 0] < 19} { set alt i386-x86_64 } else { set alt {} } } arm { lappend alt x86_64 } 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 } } set major 10 set minor 15 } # Add 10.5 to 10.minor to patterns. for {set j $minor} {$j >= 5} {incr j -1} { if {$cpu ne "arm"} { lappend res macosx${major}.${j}-${cpu} } foreach a $alt { lappend res macosx${major}.${j}-$a } } # Add unversioned patterns for 10.3/10.4 builds. lappend res macosx-${cpu} |
︙ | ︙ | |||
374 375 376 377 378 379 380 | return $res } # ### ### ### ######### ######### ######### ## Ready | | | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 | return $res } # ### ### ### ######### ######### ######### ## Ready package provide platform 1.0.17 # ### ### ### ######### ######### ######### ## Demo application if {[info exists argv0] && ($argv0 eq [info script])} { puts ==================================== parray tcl_platform |
︙ | ︙ |
Deleted library/reg/pkgIndex.tcl.
|
| < < < < |
Added library/registry/pkgIndex.tcl.
> > > > > > > > > | 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.
1 2 3 4 5 6 7 8 9 | # safe.tcl -- # # This file provide a safe loading/sourcing mechanism for safe interpreters. # It implements a virtual path mecanism to hide the real pathnames from the # child. It runs in a parent interpreter and sets up data structure and # aliases that will be invoked when used from a child interpreter. # # See the safe.n man page for details. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # safe.tcl -- # # This file provide a safe loading/sourcing mechanism for safe interpreters. # It implements a virtual path mecanism to hide the real pathnames from the # child. It runs in a parent interpreter and sets up data structure and # aliases that will be invoked when used from a child interpreter. # # See the safe.n man page for details. # # Copyright © 1996-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # The implementation is based on namespaces. These naming conventions are # followed: |
︙ | ︙ | |||
976 977 978 979 980 981 982 | # Passed all the tests, lets source it. Note that we do this all manually # because we want to control [info script] in the child so information # doesn't leak so much. [Bug 2913625] set old [::interp eval $child {info script}] set replacementMsg "script error" set code [catch { set f [open $realfile] | | | 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 | # Passed all the tests, lets source it. Note that we do this all manually # because we want to control [info script] in the child so information # doesn't leak so much. [Bug 2913625] set old [::interp eval $child {info script}] set replacementMsg "script error" set code [catch { set f [open $realfile] fconfigure $f -encoding $encoding -eofchar "\032 {}" set contents [read $f] close $f ::interp eval $child [list info script $file] } msg opt] if {$code == 0} { set code [catch {::interp eval $child $contents} msg opt] set replacementMsg $msg |
︙ | ︙ | |||
1005 1006 1007 1008 1009 1010 1011 | set argc [llength $args] if {$argc > 2} { set msg "load error: too many arguments" Log $child "$msg ($argc) {$file $args}" return -code error $msg } | | | | | | | | | | | 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 | set argc [llength $args] if {$argc > 2} { set msg "load error: too many arguments" Log $child "$msg ($argc) {$file $args}" return -code error $msg } # prefix (can be empty if file is not). set prefix [lindex $args 0] namespace upvar ::safe [VarName $child] state # Determine where to load. load use a relative interp path and {} # means self, so we can directly and safely use passed arg. set target [lindex $args 1] if {$target ne ""} { # we will try to load into a sub sub interp; check that we want to # authorize that. if {!$state(nestedok)} { Log $child "loading to a sub interp (nestedok)\ disabled (trying to load $prefix to $target)" return -code error "permission denied (nested load)" } } # Determine what kind of load is requested if {$file eq ""} { # static loading if {$prefix eq ""} { set msg "load error: empty filename and no prefix" Log $child $msg return -code error $msg } if {!$state(staticsok)} { Log $child "static loading disabled\ (trying to load $prefix to $target)" return -code error "permission denied (static library)" } } else { # file loading # get the real path from the virtual one. try { set file [TranslatePath $child $file] |
︙ | ︙ | |||
1057 1058 1059 1060 1061 1062 1063 | } on error msg { Log $child $msg return -code error "permission denied (path)" } } try { | | | | | 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 | } on error msg { Log $child $msg return -code error "permission denied (path)" } } try { return [::interp invokehidden $child load $file $prefix $target] } on error msg { # Some libraries return no error message. set msg0 "load of library for prefix $prefix failed" if {$msg eq {}} { set msg $msg0 } else { set msg "$msg0: $msg" } Log $child $msg return -code error $msg |
︙ | ︙ |
Changes to library/tcltest/pkgIndex.tcl.
1 2 3 4 5 6 7 8 9 10 11 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} | | | 1 2 3 4 5 6 7 8 9 10 11 12 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded tcltest 2.5.4 [list source [file join $dir tcltest.tcl]] |
Changes to library/tcltest/tcltest.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # 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 (c) 1994-1997 Sun Microsystems, Inc. | | | | > | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # 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 (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # Copyright (c) 2000 Ajuba Solutions # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # 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, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. variable Version 2.5.4 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] # yourself. You don't need tcltest to wrap it for you. variable version [package provide Tcl] variable patchLevel [info patchlevel] ##### Export the public tcltest procs; several categories # # Export the main functional commands that do useful things namespace export cleanupTests loadTestedCommands makeDirectory \ makeFile removeDirectory removeFile runAllTests test # Export configuration commands that control the functional commands namespace export configure customMatch errorChannel interpreter \ outputChannel testConstraint # Export commands that are duplication (candidates for deprecation) if {![package vsatisfies [package provide Tcl] 8.7-]} { namespace export bytestring ;# dups [encoding convertfrom identity] } namespace export debug ;# [configure -debug] namespace export errorFile ;# [configure -errfile] namespace export limitConstraints ;# [configure -limitconstraints] namespace export loadFile ;# [configure -loadfile] namespace export loadScript ;# [configure -load] namespace export match ;# [configure -match] namespace export matchFiles ;# [configure -file] |
︙ | ︙ | |||
393 394 395 396 397 398 399 400 401 402 403 404 405 406 | switch -exact -- $filename { stderr - stdout { set outputChannel $filename } default { set outputChannel [open $filename a] set ChannelsWeOpened($outputChannel) 1 # If we created the file in [temporaryDirectory], then # [cleanupTests] will delete it, unless we claim it was # already there. set outdir [normalizePath [file dirname \ [file join [pwd] $filename]]] | > > > | 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 | switch -exact -- $filename { stderr - stdout { set outputChannel $filename } default { set outputChannel [open $filename a] if {[package vsatisfies [package provide Tcl] 8.7-]} { fconfigure $outputChannel -encoding utf-8 } set ChannelsWeOpened($outputChannel) 1 # If we created the file in [temporaryDirectory], then # [cleanupTests] will delete it, unless we claim it was # already there. set outdir [normalizePath [file dirname \ [file join [pwd] $filename]]] |
︙ | ︙ | |||
437 438 439 440 441 442 443 444 445 446 447 448 449 450 | switch -exact -- $filename { stderr - stdout { set errorChannel $filename } default { set errorChannel [open $filename a] set ChannelsWeOpened($errorChannel) 1 # If we created the file in [temporaryDirectory], then # [cleanupTests] will delete it, unless we claim it was # already there. set outdir [normalizePath [file dirname \ [file join [pwd] $filename]]] | > > > | 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 | switch -exact -- $filename { stderr - stdout { set errorChannel $filename } default { set errorChannel [open $filename a] if {[package vsatisfies [package provide Tcl] 8.7-]} { fconfigure $errorChannel -encoding utf-8 } set ChannelsWeOpened($errorChannel) 1 # If we created the file in [temporaryDirectory], then # [cleanupTests] will delete it, unless we claim it was # already there. set outdir [normalizePath [file dirname \ [file join [pwd] $filename]]] |
︙ | ︙ | |||
636 637 638 639 640 641 642 | } } return $valid } proc IsVerbose {level} { variable Option | | | 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 | } } return $valid } proc IsVerbose {level} { variable Option return [expr {$level in $Option(-verbose)}] } # Default verbosity is to show bodies of failed tests Option -verbose {body error} { Takes any combination of the values 'p', 's', 'b', 't', 'e' and 'l'. Test suite will display all passed tests if 'p' is specified, all skipped tests if 's' is specified, the bodies of failed tests if |
︙ | ︙ | |||
779 780 781 782 783 784 785 786 787 788 789 790 791 792 | set file [file join [temporaryDirectory] $file] return [AcceptReadable $file] } proc ReadLoadScript {args} { variable Option if {$Option(-loadfile) eq {}} {return} set tmp [open $Option(-loadfile) r] loadScript [read $tmp] close $tmp } Option -loadfile {} { Read the script to load the tested commands from the specified file. } AcceptLoadFile loadFile trace add variable Option(-loadfile) write [namespace code ReadLoadScript] | > > > | 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 | set file [file join [temporaryDirectory] $file] return [AcceptReadable $file] } proc ReadLoadScript {args} { variable Option if {$Option(-loadfile) eq {}} {return} set tmp [open $Option(-loadfile) r] if {[package vsatisfies [package provide Tcl] 8.7-]} { fconfigure $tmp -encoding utf-8 } loadScript [read $tmp] close $tmp } Option -loadfile {} { Read the script to load the tested commands from the specified file. } AcceptLoadFile loadFile trace add variable Option(-loadfile) write [namespace code ReadLoadScript] |
︙ | ︙ | |||
1265 1266 1267 1268 1269 1270 1271 | ConstraintInitializer notRoot {expr {![testConstraint root]}} # Set nonBlockFiles constraint: 1 means this platform supports # setting files into nonblocking mode. ConstraintInitializer nonBlockFiles { set code [expr {[catch {set f [open defs r]}] | | | 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 | ConstraintInitializer notRoot {expr {![testConstraint root]}} # Set nonBlockFiles constraint: 1 means this platform supports # setting files into nonblocking mode. ConstraintInitializer nonBlockFiles { set code [expr {[catch {set f [open defs r]}] || [catch {fconfigure $f -blocking off}]}] catch {close $f} set code } # Set asyncPipeClose constraint: 1 means this platform supports # async flush and async close on a pipe. # |
︙ | ︙ | |||
1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 | } set code } ConstraintInitializer stdio { set code 0 if {![catch {set f [open "|[list [interpreter]]" w]}]} { if {![catch {puts $f exit}]} { if {![catch {close $f}]} { set code 1 } } } set code | > > > | 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 | } set code } ConstraintInitializer stdio { set code 0 if {![catch {set f [open "|[list [interpreter]]" w]}]} { if {[package vsatisfies [package provide Tcl] 8.7-]} { fconfigure $f -encoding utf-8 } if {![catch {puts $f exit}]} { if {![catch {close $f}]} { set code 1 } } } set code |
︙ | ︙ | |||
2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 | [dict get $testFrame type] eq "source"} { set testFile [dict get $testFrame file] set testLine [dict get $testFrame line] } else { set testFile [file normalize [uplevel 1 {info script}]] if {[file readable $testFile]} { set testFd [open $testFile r] set testLine [expr {[lsearch -regexp \ [split [read $testFd] "\n"] \ "^\[ \t\]*test [string map {. \\.} $name] "] + 1}] close $testFd } } if {[info exists testLine]} { | > > > | 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 | [dict get $testFrame type] eq "source"} { set testFile [dict get $testFrame file] set testLine [dict get $testFrame line] } else { set testFile [file normalize [uplevel 1 {info script}]] if {[file readable $testFile]} { set testFd [open $testFile r] if {[package vsatisfies [package provide Tcl] 8.7-]} { fconfigure $testFd -encoding utf-8 } set testLine [expr {[lsearch -regexp \ [split [read $testFd] "\n"] \ "^\[ \t\]*test [string map {. \\.} $name] "] + 1}] close $testFd } } if {[info exists testLine]} { |
︙ | ︙ | |||
2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 | } lappend childargv $opt $value } set cmd [linsert $childargv 0 | $shell $file] if {[catch { incr numTestFiles set pipeFd [open $cmd "r"] while {[gets $pipeFd line] >= 0} { if {[regexp [join { {^([^:]+):\t} {Total\t([0-9]+)\t} {Passed\t([0-9]+)\t} {Skipped\t([0-9]+)\t} {Failed\t([0-9]+)} | > > > | 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 | } lappend childargv $opt $value } set cmd [linsert $childargv 0 | $shell $file] if {[catch { incr numTestFiles set pipeFd [open $cmd "r"] if {[package vsatisfies [package provide Tcl] 8.7-]} { fconfigure $pipeFd -encoding utf-8 } while {[gets $pipeFd line] >= 0} { if {[regexp [join { {^([^:]+):\t} {Total\t([0-9]+)\t} {Passed\t([0-9]+)\t} {Skipped\t([0-9]+)\t} {Failed\t([0-9]+)} |
︙ | ︙ | |||
3075 3076 3077 3078 3079 3080 3081 | set fullName [file join $directory $name] DebugPuts 3 "[lindex [info level 0] 0]:\ putting ``$contents'' into $fullName" set fd [open $fullName w] | | > > > | 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 | set fullName [file join $directory $name] DebugPuts 3 "[lindex [info level 0] 0]:\ putting ``$contents'' into $fullName" set fd [open $fullName w] fconfigure $fd -translation lf if {[package vsatisfies [package provide Tcl] 8.7-]} { fconfigure $fd -encoding utf-8 } if {[string index $contents end] eq "\n"} { puts -nonewline $fd $contents } else { puts $fd $contents } close $fd |
︙ | ︙ | |||
3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 | proc tcltest::viewFile {name {directory ""}} { FillFilesExisted if {[llength [info level 0]] == 2} { set directory [temporaryDirectory] } set fullName [file join $directory $name] set f [open $fullName] set data [read -nonewline $f] close $f return $data } # tcltest::bytestring -- # | > > > | 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 | proc tcltest::viewFile {name {directory ""}} { FillFilesExisted if {[llength [info level 0]] == 2} { set directory [temporaryDirectory] } set fullName [file join $directory $name] set f [open $fullName] if {[package vsatisfies [package provide Tcl] 8.7-]} { fconfigure $f -encoding utf-8 } set data [read -nonewline $f] close $f return $data } # tcltest::bytestring -- # |
︙ | ︙ | |||
3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 | # instance to confirm that "\xE0\0" in a Tcl script is stored # internally in UTF-8 as the sequence of bytes "\xC3\xA0\xC0\x80". # # Generally, it's a bad idea to examine the bytes in a Tcl string or to # construct improperly formed strings in this manner, because it involves # exposing that Tcl uses UTF-8 internally. # # Arguments: # string being converted # # Results: # result fom encoding # # Side effects: # None | > > > > | | > | 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 | # instance to confirm that "\xE0\0" in a Tcl script is stored # internally in UTF-8 as the sequence of bytes "\xC3\xA0\xC0\x80". # # Generally, it's a bad idea to examine the bytes in a Tcl string or to # construct improperly formed strings in this manner, because it involves # exposing that Tcl uses UTF-8 internally. # # This function doesn't work any more in Tcl 8.7, since the 'identity' # is gone (TIP #345) # # Arguments: # string being converted # # Results: # result fom encoding # # Side effects: # None if {![package vsatisfies [package provide Tcl] 8.7-]} { proc tcltest::bytestring {string} { return [encoding convertfrom identity $string] } } # tcltest::OpenFiles -- # # used in io tests, uses testchannel # # Arguments: |
︙ | ︙ |
Changes to library/tm.tcl.
︙ | ︙ | |||
312 313 314 315 316 317 318 | # # Sideeffects # May add paths to the list of defaults. proc ::tcl::tm::Defaults {} { global env tcl_platform | | | 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 | # # Sideeffects # May add paths to the list of defaults. proc ::tcl::tm::Defaults {} { global env tcl_platform regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor set exe [file normalize [info nameofexecutable]] # Note that we're using [::list], not [list] because [list] means # something other than [::list] in this namespace. roots [::list \ [file dirname [info library]] \ [file join [file dirname [file dirname $exe]] lib] \ |
︙ | ︙ | |||
355 356 357 358 359 360 361 | # Results # No result. # # Sideeffects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { | | | 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 | # Results # No result. # # Sideeffects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { set px [file join $p ${major}.${n}] if {![interp issafe]} {set px [file normalize $px]} path add $px } |
︙ | ︙ |
Changes to library/tzdata/Africa/Accra.
1 2 3 4 | # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Accra) { {-9223372036854775808 -52 0 LMT} | | > > | | | | | | | > > > > | | | | | | | | | | | | | | > > > > | | | | | | | | | | | | | | > > | > | > | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Accra) { {-9223372036854775808 -52 0 LMT} {-1709337548 0 0 GMT} {-1581206400 1200 1 +0020} {-1577917200 0 0 GMT} {-1556834400 1200 1 +0020} {-1546294800 0 0 GMT} {-1525298400 1200 1 +0020} {-1514758800 0 0 GMT} {-1493762400 1200 1 +0020} {-1483222800 0 0 GMT} {-1462226400 1200 1 +0020} {-1451686800 0 0 GMT} {-1430604000 1200 1 +0020} {-1420064400 0 0 GMT} {-1399068000 1200 1 +0020} {-1388528400 0 0 GMT} {-1367532000 1200 1 +0020} {-1356992400 0 0 GMT} {-1335996000 1200 1 +0020} {-1325456400 0 0 GMT} {-1304373600 1200 1 +0020} {-1293834000 0 0 GMT} {-1272837600 1200 1 +0020} {-1262298000 0 0 GMT} {-1241301600 1200 1 +0020} {-1230762000 0 0 GMT} {-1209765600 1200 1 +0020} {-1199226000 0 0 GMT} {-1178143200 1200 1 +0020} {-1167603600 0 0 GMT} {-1146607200 1200 1 +0020} {-1136067600 0 0 GMT} {-1115071200 1200 1 +0020} {-1104531600 0 0 GMT} {-1083535200 1200 1 +0020} {-1072995600 0 0 GMT} {-1051912800 1200 1 +0020} {-1041373200 0 0 GMT} {-1020376800 1200 1 +0020} {-1009837200 0 0 GMT} {-988840800 1200 1 +0020} {-978301200 0 0 GMT} {-957304800 1200 1 +0020} {-946765200 0 0 GMT} {-936309600 1200 1 +0020} {-915142800 0 0 GMT} {-904773600 1200 1 +0020} {-883606800 0 0 GMT} {-880329600 1800 0 +0030} {-756952200 0 0 GMT} {-610149600 1800 1 +0030} {-599610600 0 0 GMT} {-578613600 1800 1 +0030} {-568074600 0 0 GMT} {-546991200 1800 1 +0030} {-536452200 0 0 GMT} {-515455200 1800 1 +0030} {-504916200 0 0 GMT} {-483919200 1800 1 +0030} {-473380200 0 0 GMT} {-452383200 1800 1 +0030} {-441844200 0 0 GMT} } |
Changes to library/tzdata/Africa/Juba.
︙ | ︙ | |||
32 33 34 35 36 37 38 39 | {419983200 10800 1 CAST} {435013200 7200 0 CAT} {452037600 10800 1 CAST} {466635600 7200 0 CAT} {483487200 10800 1 CAST} {498171600 7200 0 CAT} {947930400 10800 0 EAT} } | > | 32 33 34 35 36 37 38 39 40 | {419983200 10800 1 CAST} {435013200 7200 0 CAT} {452037600 10800 1 CAST} {466635600 7200 0 CAT} {483487200 10800 1 CAST} {498171600 7200 0 CAT} {947930400 10800 0 EAT} {1612126800 7200 0 CAT} } |
Changes to library/tzdata/Africa/Lagos.
1 2 3 | # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Lagos) { | | > > > | | 1 2 3 4 5 6 7 8 9 | # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Lagos) { {-9223372036854775808 815 0 LMT} {-2035584815 0 0 GMT} {-1940889600 815 0 LMT} {-1767226415 1800 0 +0030} {-1588465800 3600 0 WAT} } |
Changes to library/tzdata/Africa/Nairobi.
1 2 3 4 | # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Nairobi) { {-9223372036854775808 8836 0 LMT} | > | | | | | 1 2 3 4 5 6 7 8 9 10 | # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Nairobi) { {-9223372036854775808 8836 0 LMT} {-1946168836 9000 0 +0230} {-1309746600 10800 0 EAT} {-1261969200 9000 0 +0230} {-1041388200 9900 0 +0245} {-865305900 10800 0 EAT} } |
Changes to library/tzdata/America/Belize.
︙ | ︙ | |||
47 48 49 50 51 52 53 | {-974658600 -21600 0 CST} {-954093600 -19800 1 -0530} {-943209000 -21600 0 CST} {-922644000 -19800 1 -0530} {-911759400 -21600 0 CST} {-891194400 -19800 1 -0530} {-879705000 -21600 0 CST} | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > | 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 | {-974658600 -21600 0 CST} {-954093600 -19800 1 -0530} {-943209000 -21600 0 CST} {-922644000 -19800 1 -0530} {-911759400 -21600 0 CST} {-891194400 -19800 1 -0530} {-879705000 -21600 0 CST} {-868212000 -18000 1 CWT} {-769395600 -18000 1 CPT} {-758746800 -21600 0 CST} {-701892000 -19800 1 -0530} {-690402600 -21600 0 CST} {-670442400 -19800 1 -0530} {-658953000 -21600 0 CST} {-638992800 -19800 1 -0530} {-627503400 -21600 0 CST} {-606938400 -19800 1 -0530} {-596053800 -21600 0 CST} {-575488800 -19800 1 -0530} {-564604200 -21600 0 CST} {-544039200 -19800 1 -0530} {-532549800 -21600 0 CST} {-512589600 -19800 1 -0530} {-501100200 -21600 0 CST} {-481140000 -19800 1 -0530} {-469650600 -21600 0 CST} {-449690400 -19800 1 -0530} {-438201000 -21600 0 CST} {-417636000 -19800 1 -0530} {-406751400 -21600 0 CST} {-386186400 -19800 1 -0530} {-375301800 -21600 0 CST} {-354736800 -19800 1 -0530} {-343247400 -21600 0 CST} {-323287200 -19800 1 -0530} {-311797800 -21600 0 CST} {-291837600 -19800 1 -0530} {-280348200 -21600 0 CST} {-259783200 -19800 1 -0530} {-248898600 -21600 0 CST} {-228333600 -19800 1 -0530} {-217449000 -21600 0 CST} {-196884000 -19800 1 -0530} {-185999400 -21600 0 CST} {-165434400 -19800 1 -0530} {-153945000 -21600 0 CST} {-133984800 -19800 1 -0530} {-122495400 -21600 0 CST} {-102535200 -19800 1 -0530} {-91045800 -21600 0 CST} {-70480800 -19800 1 -0530} {-59596200 -21600 0 CST} {123919200 -18000 1 CDT} {129618000 -21600 0 CST} {409039200 -18000 1 CDT} {413874000 -21600 0 CST} } |
Changes to library/tzdata/America/Grand_Turk.
︙ | ︙ | |||
73 74 75 76 77 78 79 | {1320559200 -18000 0 EST} {1331449200 -14400 1 EDT} {1352008800 -18000 0 EST} {1362898800 -14400 1 EDT} {1383458400 -18000 0 EST} {1394348400 -14400 1 EDT} {1414908000 -18000 0 EST} | | < | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | {1320559200 -18000 0 EST} {1331449200 -14400 1 EDT} {1352008800 -18000 0 EST} {1362898800 -14400 1 EDT} {1383458400 -18000 0 EST} {1394348400 -14400 1 EDT} {1414908000 -18000 0 EST} {1425798000 -14400 0 AST} {1520751600 -14400 0 EDT} {1541311200 -18000 0 EST} {1552201200 -14400 1 EDT} {1572760800 -18000 0 EST} {1583650800 -14400 1 EDT} {1604210400 -18000 0 EST} {1615705200 -14400 1 EDT} |
︙ | ︙ |
Changes to library/tzdata/America/Nassau.
1 2 3 4 5 6 7 8 9 10 11 12 | # created by tools/tclZIC.tcl - do not edit set TZData(:America/Nassau) { {-9223372036854775808 -18570 0 LMT} {-1825095030 -18000 0 EST} {-179341200 -14400 1 EDT} {-163620000 -18000 0 EST} {-147891600 -14400 1 EDT} {-131565600 -18000 0 EST} {-116442000 -14400 1 EDT} {-100116000 -18000 0 EST} {-84387600 -14400 1 EDT} | > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # created by tools/tclZIC.tcl - do not edit set TZData(:America/Nassau) { {-9223372036854775808 -18570 0 LMT} {-1825095030 -18000 0 EST} {-873140400 -14400 1 EWT} {-788904000 -18000 0 EST} {-786222000 -14400 1 EWT} {-769395600 -14400 1 EPT} {-763848000 -18000 0 EST} {-179341200 -14400 1 EDT} {-163620000 -18000 0 EST} {-147891600 -14400 1 EDT} {-131565600 -18000 0 EST} {-116442000 -14400 1 EDT} {-100116000 -18000 0 EST} {-84387600 -14400 1 EDT} |
︙ | ︙ |
Changes to library/tzdata/Antarctica/Macquarie.
1 2 3 4 5 6 7 | # created by tools/tclZIC.tcl - do not edit set TZData(:Antarctica/Macquarie) { {-9223372036854775808 0 0 -00} {-2214259200 36000 0 AEST} {-1680508800 39600 1 AEDT} {-1669892400 39600 0 AEDT} | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # created by tools/tclZIC.tcl - do not edit set TZData(:Antarctica/Macquarie) { {-9223372036854775808 0 0 -00} {-2214259200 36000 0 AEST} {-1680508800 39600 1 AEDT} {-1669892400 39600 0 AEDT} {-1665388800 36000 0 AEST} {-1601719200 0 0 -00} {-94730400 36000 0 AEST} {-71136000 39600 1 AEDT} {-55411200 36000 0 AEST} {-37267200 39600 1 AEDT} {-25776000 36000 0 AEST} {-5817600 39600 1 AEDT} |
︙ | ︙ |
Changes to library/tzdata/Asia/Gaza.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Gaza) { {-9223372036854775808 8272 0 LMT} {-2185409872 7200 0 EEST} | | > > | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Gaza) { {-9223372036854775808 8272 0 LMT} {-2185409872 7200 0 EEST} {-933638400 10800 1 EEST} {-923097600 7200 0 EEST} {-919036800 10800 1 EEST} {-857347200 7200 0 EEST} {-844300800 10800 1 EEST} {-825811200 7200 0 EEST} {-812678400 10800 1 EEST} {-794188800 7200 0 EEST} {-779846400 10800 1 EEST} {-762652800 7200 0 EEST} {-748310400 10800 1 EEST} {-731116800 7200 0 EEST} {-682653600 7200 0 EET} {-399088800 10800 1 EEST} {-386650800 7200 0 EET} {-368330400 10800 1 EEST} {-355114800 7200 0 EET} {-336790800 10800 1 EEST} {-323654400 7200 0 EET} |
︙ | ︙ | |||
36 37 38 39 40 41 42 | {-102643200 7200 0 EET} {-84330000 10800 1 EEST} {-81313200 10800 0 IST} {142376400 10800 1 IDT} {150843600 7200 0 IST} {167176800 10800 1 IDT} {178664400 7200 0 IST} | | | | | | | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | {-102643200 7200 0 EET} {-84330000 10800 1 EEST} {-81313200 10800 0 IST} {142376400 10800 1 IDT} {150843600 7200 0 IST} {167176800 10800 1 IDT} {178664400 7200 0 IST} {334101600 10800 1 IDT} {337730400 7200 0 IST} {452642400 10800 1 IDT} {462319200 7200 0 IST} {482277600 10800 1 IDT} {494370000 7200 0 IST} {516751200 10800 1 IDT} {526424400 7200 0 IST} {545436000 10800 1 IDT} {558478800 7200 0 IST} {576626400 10800 1 IDT} {589323600 7200 0 IST} {609890400 10800 1 IDT} |
︙ | ︙ |
Changes to library/tzdata/Asia/Hebron.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Hebron) { {-9223372036854775808 8423 0 LMT} {-2185410023 7200 0 EEST} | | > > | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Hebron) { {-9223372036854775808 8423 0 LMT} {-2185410023 7200 0 EEST} {-933638400 10800 1 EEST} {-923097600 7200 0 EEST} {-919036800 10800 1 EEST} {-857347200 7200 0 EEST} {-844300800 10800 1 EEST} {-825811200 7200 0 EEST} {-812678400 10800 1 EEST} {-794188800 7200 0 EEST} {-779846400 10800 1 EEST} {-762652800 7200 0 EEST} {-748310400 10800 1 EEST} {-731116800 7200 0 EEST} {-682653600 7200 0 EET} {-399088800 10800 1 EEST} {-386650800 7200 0 EET} {-368330400 10800 1 EEST} {-355114800 7200 0 EET} {-336790800 10800 1 EEST} {-323654400 7200 0 EET} |
︙ | ︙ | |||
36 37 38 39 40 41 42 | {-102643200 7200 0 EET} {-84330000 10800 1 EEST} {-81313200 10800 0 IST} {142376400 10800 1 IDT} {150843600 7200 0 IST} {167176800 10800 1 IDT} {178664400 7200 0 IST} | | | | | | | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | {-102643200 7200 0 EET} {-84330000 10800 1 EEST} {-81313200 10800 0 IST} {142376400 10800 1 IDT} {150843600 7200 0 IST} {167176800 10800 1 IDT} {178664400 7200 0 IST} {334101600 10800 1 IDT} {337730400 7200 0 IST} {452642400 10800 1 IDT} {462319200 7200 0 IST} {482277600 10800 1 IDT} {494370000 7200 0 IST} {516751200 10800 1 IDT} {526424400 7200 0 IST} {545436000 10800 1 IDT} {558478800 7200 0 IST} {576626400 10800 1 IDT} {589323600 7200 0 IST} {609890400 10800 1 IDT} |
︙ | ︙ |
Changes to library/tzdata/Asia/Jerusalem.
1 2 3 4 5 6 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Jerusalem) { {-9223372036854775808 8454 0 LMT} {-2840149254 8440 0 JMT} {-1641003640 7200 0 IST} | | > > | | | | | | | | | | | | | | | | | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Jerusalem) { {-9223372036854775808 8454 0 LMT} {-2840149254 8440 0 JMT} {-1641003640 7200 0 IST} {-933638400 10800 1 IDT} {-923097600 7200 0 IST} {-919036800 10800 1 IDT} {-857347200 7200 0 IST} {-844300800 10800 1 IDT} {-825811200 7200 0 IST} {-812678400 10800 1 IDT} {-794188800 7200 0 IST} {-779846400 10800 1 IDT} {-762652800 7200 0 IST} {-748310400 10800 1 IDT} {-731116800 7200 0 IST} {-681955200 14400 1 IDDT} {-673228800 10800 1 IDT} {-667958400 7200 0 IST} {-652320000 10800 1 IDT} {-636422400 7200 0 IST} {-622080000 10800 1 IDT} {-608947200 7200 0 IST} {-591840000 10800 1 IDT} {-572486400 7200 0 IST} {-558576000 10800 1 IDT} {-542851200 7200 0 IST} {-527731200 10800 1 IDT} {-514425600 7200 0 IST} {-490838400 10800 1 IDT} {-482976000 7200 0 IST} {-459388800 10800 1 IDT} {-451526400 7200 0 IST} {-428544000 10800 1 IDT} {-418262400 7200 0 IST} {-400118400 10800 1 IDT} {-387417600 7200 0 IST} {142380000 10800 1 IDT} {150843600 7200 0 IST} {167176800 10800 1 IDT} {178664400 7200 0 IST} {334101600 10800 1 IDT} {337730400 7200 0 IST} {452642400 10800 1 IDT} {462319200 7200 0 IST} {482277600 10800 1 IDT} {494370000 7200 0 IST} {516751200 10800 1 IDT} {526424400 7200 0 IST} {545436000 10800 1 IDT} {558478800 7200 0 IST} {576626400 10800 1 IDT} {589323600 7200 0 IST} {609890400 10800 1 IDT} |
︙ | ︙ |
Changes to library/tzdata/Atlantic/Bermuda.
1 2 3 4 | # created by tools/tclZIC.tcl - do not edit set TZData(:Atlantic/Bermuda) { {-9223372036854775808 -15558 0 LMT} | > > > > > | > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # created by tools/tclZIC.tcl - do not edit set TZData(:Atlantic/Bermuda) { {-9223372036854775808 -15558 0 LMT} {-2524506042 -15558 0 BMT} {-1664307642 -11958 1 BMT} {-1648932042 -15558 0 BMT} {-1632080442 -11958 1 BMT} {-1618692042 -15558 0 BST} {-1262281242 -14400 0 AT} {-882727200 -10800 1 ADT} {-858538800 -14400 0 AST} {-845229600 -10800 1 ADT} {-825879600 -14400 0 AST} {-814384800 -10800 1 ADT} {-793825200 -14400 0 AST} {-782935200 -10800 1 ADT} {-762375600 -14400 0 AST} {-713988000 -10800 1 ADT} {-703710000 -14400 0 AST} {-681933600 -10800 1 ADT} {-672865200 -14400 0 AST} {-650484000 -10800 1 ADT} {-641415600 -14400 0 AST} {-618429600 -10800 1 ADT} {-609966000 -14400 0 AST} {-586980000 -10800 1 ADT} {-578516400 -14400 0 AST} {-555530400 -10800 1 ADT} {-546462000 -14400 0 AST} {-429127200 -10800 1 ADT} {-415825200 -14400 0 AST} {136360800 -10800 0 ADT} {152082000 -14400 0 AST} {167810400 -10800 1 ADT} {183531600 -14400 0 AST} {189316800 -14400 0 AST} {199260000 -10800 1 ADT} {215586000 -14400 0 AST} |
︙ | ︙ |
Changes to library/tzdata/Australia/Adelaide.
1 2 3 4 5 6 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Adelaide) { {-9223372036854775808 33260 0 LMT} {-2364110060 32400 0 ACST} {-2230189200 34200 0 ACST} | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Adelaide) { {-9223372036854775808 33260 0 LMT} {-2364110060 32400 0 ACST} {-2230189200 34200 0 ACST} {-1672558200 37800 1 ACDT} {-1665387000 34200 0 ACST} {-883639800 37800 1 ACDT} {-876123000 34200 0 ACST} {-860398200 37800 1 ACDT} {-844673400 34200 0 ACST} {-828343800 37800 1 ACDT} {-813223800 34200 0 ACST} {31501800 34200 0 ACST} {57688200 37800 1 ACDT} {67969800 34200 0 ACST} {89137800 37800 1 ACDT} {100024200 34200 0 ACST} {120587400 37800 1 ACDT} {131473800 34200 0 ACST} |
︙ | ︙ |
Changes to library/tzdata/Australia/Brisbane.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Brisbane) { {-9223372036854775808 36728 0 LMT} {-2366791928 36000 0 AEST} | | | | | | | 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(:Australia/Brisbane) { {-9223372036854775808 36728 0 LMT} {-2366791928 36000 0 AEST} {-1672560000 39600 1 AEDT} {-1665388800 36000 0 AEST} {-883641600 39600 1 AEDT} {-876124800 36000 0 AEST} {-860400000 39600 1 AEDT} {-844675200 36000 0 AEST} {-828345600 39600 1 AEDT} {-813225600 36000 0 AEST} {31500000 36000 0 AEST} {57686400 39600 1 AEDT} {67968000 36000 0 AEST} {625593600 39600 1 AEDT} {636480000 36000 0 AEST} {657043200 39600 1 AEDT} {667929600 36000 0 AEST} |
︙ | ︙ |
Changes to library/tzdata/Australia/Broken_Hill.
1 2 3 4 5 6 7 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Broken_Hill) { {-9223372036854775808 33948 0 LMT} {-2364110748 36000 0 AEST} {-2314951200 32400 0 ACST} {-2230189200 34200 0 ACST} | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Broken_Hill) { {-9223372036854775808 33948 0 LMT} {-2364110748 36000 0 AEST} {-2314951200 32400 0 ACST} {-2230189200 34200 0 ACST} {-1672558200 37800 1 ACDT} {-1665387000 34200 0 ACST} {-883639800 37800 1 ACDT} {-876123000 34200 0 ACST} {-860398200 37800 1 ACDT} {-844673400 34200 0 ACST} {-828343800 37800 1 ACDT} {-813223800 34200 0 ACST} {31501800 34200 0 ACST} {57688200 37800 1 ACDT} {67969800 34200 0 ACST} {89137800 37800 1 ACDT} {100024200 34200 0 ACST} {120587400 37800 1 ACDT} {131473800 34200 0 ACST} |
︙ | ︙ |
Changes to library/tzdata/Australia/Currie.
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(Australia/Hobart)]} { LoadTimeZoneFile Australia/Hobart } set TZData(:Australia/Currie) $TZData(:Australia/Hobart) |
Changes to library/tzdata/Australia/Darwin.
1 2 3 4 5 6 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Darwin) { {-9223372036854775808 31400 0 LMT} {-2364108200 32400 0 ACST} {-2230189200 34200 0 ACST} | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Darwin) { {-9223372036854775808 31400 0 LMT} {-2364108200 32400 0 ACST} {-2230189200 34200 0 ACST} {-1672558200 37800 1 ACDT} {-1665387000 34200 0 ACST} {-883639800 37800 1 ACDT} {-876123000 34200 0 ACST} {-860398200 37800 1 ACDT} {-844673400 34200 0 ACST} {-828343800 37800 1 ACDT} {-813223800 34200 0 ACST} } |
Changes to library/tzdata/Australia/Eucla.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Eucla) { {-9223372036854775808 30928 0 LMT} {-2337928528 31500 0 +0945} | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Eucla) { {-9223372036854775808 30928 0 LMT} {-2337928528 31500 0 +0945} {-1672555500 35100 1 +0945} {-1665384300 31500 0 +0945} {-883637100 35100 1 +0945} {-876120300 31500 0 +0945} {-860395500 35100 1 +0945} {-844670700 31500 0 +0945} {-836473500 35100 0 +0945} {152039700 35100 1 +0945} {162926100 31500 0 +0945} {436295700 35100 1 +0945} {447182100 31500 0 +0945} {690311700 35100 1 +0945} {699383700 31500 0 +0945} |
︙ | ︙ |
Changes to library/tzdata/Australia/Hobart.
1 2 3 4 5 6 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Hobart) { {-9223372036854775808 35356 0 LMT} {-2345795356 36000 0 AEST} {-1680508800 39600 1 AEDT} | > > > | | > | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Hobart) { {-9223372036854775808 35356 0 LMT} {-2345795356 36000 0 AEST} {-1680508800 39600 1 AEDT} {-1665388800 36000 0 AEST} {-1646640000 39600 1 AEDT} {-1635753600 36000 0 AEST} {-1615190400 39600 1 AEDT} {-1604304000 36000 0 AEST} {-1583920800 36000 0 AEST} {-883641600 39600 1 AEDT} {-876124800 36000 0 AEST} {-860400000 39600 1 AEDT} {-844675200 36000 0 AEST} {-828345600 39600 1 AEDT} {-813225600 36000 0 AEST} {-94730400 36000 0 AEST} {-71136000 39600 1 AEDT} {-55411200 36000 0 AEST} {-37267200 39600 1 AEDT} {-25776000 36000 0 AEST} {-5817600 39600 1 AEDT} {5673600 36000 0 AEST} |
︙ | ︙ |
Changes to library/tzdata/Australia/Lindeman.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Lindeman) { {-9223372036854775808 35756 0 LMT} {-2366790956 36000 0 AEST} | | | | | | | 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(:Australia/Lindeman) { {-9223372036854775808 35756 0 LMT} {-2366790956 36000 0 AEST} {-1672560000 39600 1 AEDT} {-1665388800 36000 0 AEST} {-883641600 39600 1 AEDT} {-876124800 36000 0 AEST} {-860400000 39600 1 AEDT} {-844675200 36000 0 AEST} {-828345600 39600 1 AEDT} {-813225600 36000 0 AEST} {31500000 36000 0 AEST} {57686400 39600 1 AEDT} {67968000 36000 0 AEST} {625593600 39600 1 AEDT} {636480000 36000 0 AEST} {657043200 39600 1 AEDT} {667929600 36000 0 AEST} |
︙ | ︙ |
Changes to library/tzdata/Australia/Melbourne.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Melbourne) { {-9223372036854775808 34792 0 LMT} {-2364111592 36000 0 AEST} | | | | | | | 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(:Australia/Melbourne) { {-9223372036854775808 34792 0 LMT} {-2364111592 36000 0 AEST} {-1672560000 39600 1 AEDT} {-1665388800 36000 0 AEST} {-883641600 39600 1 AEDT} {-876124800 36000 0 AEST} {-860400000 39600 1 AEDT} {-844675200 36000 0 AEST} {-828345600 39600 1 AEDT} {-813225600 36000 0 AEST} {31500000 36000 0 AEST} {57686400 39600 1 AEDT} {67968000 36000 0 AEST} {89136000 39600 1 AEDT} {100022400 36000 0 AEST} {120585600 39600 1 AEDT} {131472000 36000 0 AEST} |
︙ | ︙ |
Changes to library/tzdata/Australia/Perth.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Perth) { {-9223372036854775808 27804 0 LMT} {-2337925404 28800 0 AWST} | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Perth) { {-9223372036854775808 27804 0 LMT} {-2337925404 28800 0 AWST} {-1672552800 32400 1 AWDT} {-1665381600 28800 0 AWST} {-883634400 32400 1 AWDT} {-876117600 28800 0 AWST} {-860392800 32400 1 AWDT} {-844668000 28800 0 AWST} {-836470800 32400 0 AWST} {152042400 32400 1 AWDT} {162928800 28800 0 AWST} {436298400 32400 1 AWDT} {447184800 28800 0 AWST} {690314400 32400 1 AWDT} {699386400 28800 0 AWST} |
︙ | ︙ |
Changes to library/tzdata/Australia/Sydney.
1 2 3 4 5 | # created by tools/tclZIC.tcl - do not edit set TZData(:Australia/Sydney) { {-9223372036854775808 36292 0 LMT} {-2364113092 36000 0 AEST} | | | | | | | 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(:Australia/Sydney) { {-9223372036854775808 36292 0 LMT} {-2364113092 36000 0 AEST} {-1672560000 39600 1 AEDT} {-1665388800 36000 0 AEST} {-883641600 39600 1 AEDT} {-876124800 36000 0 AEST} {-860400000 39600 1 AEDT} {-844675200 36000 0 AEST} {-828345600 39600 1 AEDT} {-813225600 36000 0 AEST} {31500000 36000 0 AEST} {57686400 39600 1 AEDT} {67968000 36000 0 AEST} {89136000 39600 1 AEDT} {100022400 36000 0 AEST} {120585600 39600 1 AEDT} {131472000 36000 0 AEST} |
︙ | ︙ |
Changes to library/tzdata/Europe/Volgograd.
︙ | ︙ | |||
65 66 67 68 69 70 71 72 | {1238281200 14400 1 +04} {1256425200 10800 0 +03} {1269730800 14400 1 +04} {1288479600 10800 0 +03} {1301180400 14400 0 +04} {1414274400 10800 0 +03} {1540681200 14400 0 +04} } | > | 65 66 67 68 69 70 71 72 73 | {1238281200 14400 1 +04} {1256425200 10800 0 +03} {1269730800 14400 1 +04} {1288479600 10800 0 +03} {1301180400 14400 0 +04} {1414274400 10800 0 +03} {1540681200 14400 0 +04} {1609020000 10800 0 +03} } |
Changes to library/tzdata/Indian/Mahe.
1 2 3 4 | # created by tools/tclZIC.tcl - do not edit set TZData(:Indian/Mahe) { {-9223372036854775808 13308 0 LMT} | | | 1 2 3 4 5 6 | # created by tools/tclZIC.tcl - do not edit set TZData(:Indian/Mahe) { {-9223372036854775808 13308 0 LMT} {-1988163708 14400 0 +04} } |
Changes to library/tzdata/Pacific/Efate.
1 2 3 4 5 6 7 | # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Efate) { {-9223372036854775808 40396 0 LMT} {-1829387596 39600 0 +11} {433256400 43200 1 +11} {448977600 39600 0 +11} | > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Efate) { {-9223372036854775808 40396 0 LMT} {-1829387596 39600 0 +11} {125409600 43200 1 +11} {133876800 39600 0 +11} {433256400 43200 1 +11} {448977600 39600 0 +11} {464706000 43200 1 +11} {480427200 39600 0 +11} {496760400 43200 1 +11} {511876800 39600 0 +11} {528210000 43200 1 +11} {543931200 39600 0 +11} {559659600 43200 1 +11} {575380800 39600 0 +11} |
︙ | ︙ |
Changes to library/word.tcl.
1 2 3 4 5 6 | # word.tcl -- # # This file defines various procedures for computing word boundaries in # strings. This file is primarily needed so Tk text and entry widgets behave # properly for different platforms. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # word.tcl -- # # This file defines various procedures for computing word boundaries in # strings. This file is primarily needed so Tk text and entry widgets behave # properly for different platforms. # # Copyright © 1996 Sun Microsystems, Inc. # Copyright © 1998 Scritpics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # The following variables are used to determine which characters are # interpreted as word characters. See bug [f1253530cdd8]. Will # probably be removed in Tcl 9. |
︙ | ︙ |
Changes to libtommath/tommath.h.
︙ | ︙ | |||
233 234 235 236 237 238 239 | # else # define MP_WUR # endif #endif #if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405) # define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x))) | < < < < < < < < > | < < | | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 | # else # define MP_WUR # endif #endif #if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405) # define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x))) # define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s) # define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s) #elif defined(_MSC_VER) && _MSC_VER >= 1500 # define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x)) # define MP_DEPRECATED_PRAGMA(s) __pragma(message(s)) #else # define MP_DEPRECATED(s) # define MP_DEPRECATED_PRAGMA(s) #endif #define DIGIT_BIT (MP_DEPRECATED_PRAGMA("DIGIT_BIT macro is deprecated, MP_DIGIT_BIT instead") MP_DIGIT_BIT) #define USED(m) (MP_DEPRECATED_PRAGMA("USED macro is deprecated, use z->used instead") (m)->used) #define DIGIT(m, k) (MP_DEPRECATED_PRAGMA("DIGIT macro is deprecated, use z->dp instead") (m)->dp[(k)]) #define SIGN(m) (MP_DEPRECATED_PRAGMA("SIGN macro is deprecated, use z->sign instead") (m)->sign) |
︙ | ︙ | |||
337 338 339 340 341 342 343 | void mp_set_u64(mp_int *a, uint64_t b); mp_err mp_init_u64(mp_int *a, uint64_t b) MP_WUR; /* get magnitude */ uint32_t mp_get_mag_u32(const mp_int *a) MP_WUR; uint64_t mp_get_mag_u64(const mp_int *a) MP_WUR; unsigned long mp_get_mag_ul(const mp_int *a) MP_WUR; | < | < < < < | | < < < < < < < < < < < < | < < | < | 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 | void mp_set_u64(mp_int *a, uint64_t b); mp_err mp_init_u64(mp_int *a, uint64_t b) MP_WUR; /* get magnitude */ uint32_t mp_get_mag_u32(const mp_int *a) MP_WUR; uint64_t mp_get_mag_u64(const mp_int *a) MP_WUR; unsigned long mp_get_mag_ul(const mp_int *a) MP_WUR; #define mp_get_mag_ull(a) ((unsigned long long)mp_get_mag_u64(a)) /* get integer, set integer (long) */ long mp_get_l(const mp_int *a) MP_WUR; void mp_set_l(mp_int *a, long b); mp_err mp_init_l(mp_int *a, long b) MP_WUR; /* get integer, set integer (unsigned long) */ #define mp_get_ul(a) ((unsigned long)mp_get_l(a)) void mp_set_ul(mp_int *a, unsigned long b); mp_err mp_init_ul(mp_int *a, unsigned long b) MP_WUR; /* get integer, set integer (long long) */ #define mp_get_ll(a) ((long long)mp_get_i64(a)) #define mp_set_ll(a,b) mp_set_i64(a,b) #define mp_init_ll(a,b) mp_init_i64(a,b) /* get integer, set integer (unsigned long long) */ #define mp_get_ull(a) ((unsigned long long)mp_get_i64(a)) #define mp_set_ull(a,b) mp_set_u64(a,b) #define mp_init_ull(a,b) mp_init_u64(a,b) /* set to single unsigned digit, up to MP_DIGIT_MAX */ void mp_set(mp_int *a, mp_digit b); mp_err mp_init_set(mp_int *a, mp_digit b) MP_WUR; /* get integer, set integer and init with integer (deprecated) */ MP_DEPRECATED(mp_get_mag_u32/mp_get_u32) unsigned long mp_get_int(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_get_mag_ul/mp_get_ul) unsigned long mp_get_long(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) unsigned long long mp_get_long_long(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_set_ul) mp_err mp_set_int(mp_int *a, unsigned long b); MP_DEPRECATED(mp_set_ul) mp_err mp_set_long(mp_int *a, unsigned long b); MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, unsigned long long b); MP_DEPRECATED(mp_init_ul) mp_err mp_init_set_int(mp_int *a, unsigned long b) MP_WUR; /* copy, b = a */ mp_err mp_copy(const mp_int *a, mp_int *b) MP_WUR; /* inits and copies, a = b */ mp_err mp_init_copy(mp_int *a, const mp_int *b) MP_WUR; |
︙ | ︙ |
Changes to macosx/GNUmakefile.
︙ | ︙ | |||
84 85 86 87 88 89 90 | OBJ_DIR = ${OBJROOT}/${BUILD_STYLE} empty := space := ${empty} ${empty} objdir = $(subst ${space},\ ,${OBJ_DIR}) develop_make_args := BUILD_STYLE=Development CONFIGURE_ARGS=--enable-symbols | | | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | OBJ_DIR = ${OBJROOT}/${BUILD_STYLE} empty := space := ${empty} ${empty} objdir = $(subst ${space},\ ,${OBJ_DIR}) develop_make_args := BUILD_STYLE=Development CONFIGURE_ARGS=--enable-symbols deploy_make_args := BUILD_STYLE=Deployment INSTALL_TARGET=install-strip \ EXTRA_CFLAGS=-DNDEBUG embedded_make_args := EMBEDDED_BUILD=1 install_make_args := INSTALL_BUILD=1 ${targets}: ${MAKE} ${action}${PROJECT} \ $(foreach s,${styles} embedded install,$(if $(findstring $s,$@),${${s}_make_args})) |
︙ | ︙ | |||
140 141 142 143 144 145 146 | ${MAKE} install-${PROJECT} INSTALL_ROOT="${OBJ_DIR}/" ${objdir}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \ ${UNIX_DIR}/tclConfig.sh.in Tcl-Info.plist.in mkdir -p "${OBJ_DIR}" && cd "${OBJ_DIR}" && \ if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \ --prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \ | | | 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | ${MAKE} install-${PROJECT} INSTALL_ROOT="${OBJ_DIR}/" ${objdir}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \ ${UNIX_DIR}/tclConfig.sh.in Tcl-Info.plist.in mkdir -p "${OBJ_DIR}" && cd "${OBJ_DIR}" && \ if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \ --prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \ --mandir="${MANDIR}" --enable-framework --enable-dtrace --disable-zipfs \ ${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi build-${PROJECT}: ${objdir}/Makefile ${DO_MAKE} ifeq (${INSTALL_BUILD},) # symolic link hackery to trick # 'make install INSTALL_ROOT=${OBJ_DIR}' |
︙ | ︙ |
Changes to macosx/Tcl-Common.xcconfig.
︙ | ︙ | |||
15 16 17 18 19 20 21 | INSTALL_MODE_FLAG = go-w,a+rX GCC_PREFIX_HEADER = $(DERIVED_FILE_DIR)/tcl/tclConfig.h GCC_GENERATE_DEBUGGING_SYMBOLS = YES GCC_NO_COMMON_BLOCKS = YES GCC_DYNAMIC_NO_PIC = YES GCC_VERSION = 4.2 GCC = gcc-$(GCC_VERSION) | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | INSTALL_MODE_FLAG = go-w,a+rX GCC_PREFIX_HEADER = $(DERIVED_FILE_DIR)/tcl/tclConfig.h GCC_GENERATE_DEBUGGING_SYMBOLS = YES GCC_NO_COMMON_BLOCKS = YES GCC_DYNAMIC_NO_PIC = YES GCC_VERSION = 4.2 GCC = gcc-$(GCC_VERSION) WARNING_CFLAGS = -Wall -Wextra -Wshadow -Wwrite-strings -Wpointer-arith -Wc++-compat -Winit-self -Wcast-align -Wdisabled-optimization -Winline $(WARNING_CFLAGS) BINDIR = $(PREFIX)/bin CFLAGS = $(CFLAGS) CPPFLAGS = -mmacosx-version-min=$(MACOSX_DEPLOYMENT_TARGET) $(CPPFLAGS) FRAMEWORK_INSTALL_PATH = /Library/Frameworks INCLUDEDIR = $(PREFIX)/include LIBDIR = $(PREFIX)/lib MANDIR = $(PREFIX)/man |
︙ | ︙ |
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>"; }; |
︙ | ︙ | |||
766 767 768 769 770 771 772 | F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; }; F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; }; F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; }; F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; }; F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; }; | < < < < < < < | 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 | F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; }; F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; }; F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; }; F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; }; F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; }; F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; }; F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; }; F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; }; F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; }; F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; }; F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; }; F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; }; F96D444208F272B9004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; }; |
︙ | ︙ | |||
834 835 836 837 838 839 840 | F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; }; F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; }; F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; }; F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; }; F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; }; F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = "<group>"; }; | < | 827 828 829 830 831 832 833 834 835 836 837 838 839 840 | F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; }; F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; }; F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; }; F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; }; F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; }; F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = "<group>"; }; F96D448108F272BA004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = "<group>"; }; F96D448208F272BA004A47F5 /* tcl.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.rc; sourceTree = "<group>"; }; F96D448308F272BA004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = "<group>"; }; F96D448408F272BA004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = "<group>"; }; F96D448608F272BA004A47F5 /* tclsh.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclsh.rc; sourceTree = "<group>"; }; F96D448708F272BA004A47F5 /* tclWin32Dll.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWin32Dll.c; sourceTree = "<group>"; }; F96D448808F272BA004A47F5 /* tclWinChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinChan.c; sourceTree = "<group>"; }; |
︙ | ︙ | |||
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 */, | | | 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 */, |
︙ | ︙ | |||
1645 1646 1647 1648 1649 1650 1651 | F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, F96D43D208F272B8004A47F5 /* configure */, F96D43D308F272B8004A47F5 /* configure.ac */, F96D442508F272B8004A47F5 /* genStubs.tcl */, F96D442708F272B8004A47F5 /* index.tcl */, F96D442808F272B8004A47F5 /* installData.tcl */, F96D442908F272B8004A47F5 /* loadICU.tcl */, | < < < < < < < < | 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 | F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, F96D43D208F272B8004A47F5 /* configure */, F96D43D308F272B8004A47F5 /* configure.ac */, F96D442508F272B8004A47F5 /* genStubs.tcl */, F96D442708F272B8004A47F5 /* index.tcl */, F96D442808F272B8004A47F5 /* installData.tcl */, F96D442908F272B8004A47F5 /* loadICU.tcl */, F96D442B08F272B8004A47F5 /* makeTestCases.tcl */, F96D443208F272B8004A47F5 /* README */, F96D443308F272B8004A47F5 /* regexpTestLib.tcl */, F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */, F96D443A08F272B9004A47F5 /* tclZIC.tcl */, F92D7F100DE777240033A13A /* tsdPerf.tcl */, F96D443B08F272B9004A47F5 /* uniClass.tcl */, F96D443C08F272B9004A47F5 /* uniParse.tcl */, ); path = tools; |
︙ | ︙ | |||
1740 1741 1742 1743 1744 1745 1746 | F96D447808F272BA004A47F5 /* makefile.vc */, F96D447908F272BA004A47F5 /* nmakehlp.c */, F96D447A08F272BA004A47F5 /* README */, F96D447C08F272BA004A47F5 /* rules.vc */, F96D447D08F272BA004A47F5 /* stub16.c */, F96D447E08F272BA004A47F5 /* tcl.dsp */, F96D447F08F272BA004A47F5 /* tcl.dsw */, | < | 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 | F96D447808F272BA004A47F5 /* makefile.vc */, F96D447908F272BA004A47F5 /* nmakehlp.c */, F96D447A08F272BA004A47F5 /* README */, F96D447C08F272BA004A47F5 /* rules.vc */, F96D447D08F272BA004A47F5 /* stub16.c */, F96D447E08F272BA004A47F5 /* tcl.dsp */, F96D447F08F272BA004A47F5 /* tcl.dsw */, F96D448108F272BA004A47F5 /* tcl.m4 */, F96D448208F272BA004A47F5 /* tcl.rc */, F96D448308F272BA004A47F5 /* tclAppInit.c */, F96D448408F272BA004A47F5 /* tclConfig.sh.in */, F96D448608F272BA004A47F5 /* tclsh.rc */, F96D448708F272BA004A47F5 /* tclWin32Dll.c */, F96D448808F272BA004A47F5 /* tclWinChan.c */, |
︙ | ︙ |
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>"; }; |
︙ | ︙ | |||
766 767 768 769 770 771 772 | F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; }; F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; }; F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; }; F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; }; F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; }; | < < < < < < < | 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 | F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; }; F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; }; F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; }; F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; }; F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; }; F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; }; F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; }; F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; }; F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; }; F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; }; F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; }; F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; }; F96D444208F272B9004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; }; |
︙ | ︙ | |||
834 835 836 837 838 839 840 | F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; }; F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; }; F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; }; F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; }; F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; }; F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = "<group>"; }; | < | 827 828 829 830 831 832 833 834 835 836 837 838 839 840 | F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; }; F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; }; F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; }; F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; }; F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; }; F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = "<group>"; }; F96D448108F272BA004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = "<group>"; }; F96D448208F272BA004A47F5 /* tcl.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.rc; sourceTree = "<group>"; }; F96D448308F272BA004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = "<group>"; }; F96D448408F272BA004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = "<group>"; }; F96D448608F272BA004A47F5 /* tclsh.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclsh.rc; sourceTree = "<group>"; }; F96D448708F272BA004A47F5 /* tclWin32Dll.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWin32Dll.c; sourceTree = "<group>"; }; F96D448808F272BA004A47F5 /* tclWinChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinChan.c; sourceTree = "<group>"; }; |
︙ | ︙ | |||
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 */, | | | 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 */, |
︙ | ︙ | |||
1639 1640 1641 1642 1643 1644 1645 | path = tests; sourceTree = "<group>"; }; F96D43D008F272B8004A47F5 /* tools */ = { isa = PBXGroup; children = ( F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, | < < < < < < < < < < | 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 | path = tests; sourceTree = "<group>"; }; F96D43D008F272B8004A47F5 /* tools */ = { isa = PBXGroup; children = ( F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, F96D442508F272B8004A47F5 /* genStubs.tcl */, F96D442708F272B8004A47F5 /* index.tcl */, F96D442808F272B8004A47F5 /* installData.tcl */, F96D442908F272B8004A47F5 /* loadICU.tcl */, F96D442B08F272B8004A47F5 /* makeTestCases.tcl */, F96D443208F272B8004A47F5 /* README */, F96D443308F272B8004A47F5 /* regexpTestLib.tcl */, F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */, F96D443A08F272B9004A47F5 /* tclZIC.tcl */, F92D7F100DE777240033A13A /* tsdPerf.tcl */, F96D443B08F272B9004A47F5 /* uniClass.tcl */, F96D443C08F272B9004A47F5 /* uniParse.tcl */, ); path = tools; |
︙ | ︙ | |||
1740 1741 1742 1743 1744 1745 1746 | F96D447808F272BA004A47F5 /* makefile.vc */, F96D447908F272BA004A47F5 /* nmakehlp.c */, F96D447A08F272BA004A47F5 /* README */, F96D447C08F272BA004A47F5 /* rules.vc */, F96D447D08F272BA004A47F5 /* stub16.c */, F96D447E08F272BA004A47F5 /* tcl.dsp */, F96D447F08F272BA004A47F5 /* tcl.dsw */, | < | 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 | F96D447808F272BA004A47F5 /* makefile.vc */, F96D447908F272BA004A47F5 /* nmakehlp.c */, F96D447A08F272BA004A47F5 /* README */, F96D447C08F272BA004A47F5 /* rules.vc */, F96D447D08F272BA004A47F5 /* stub16.c */, F96D447E08F272BA004A47F5 /* tcl.dsp */, F96D447F08F272BA004A47F5 /* tcl.dsw */, F96D448108F272BA004A47F5 /* tcl.m4 */, F96D448208F272BA004A47F5 /* tcl.rc */, F96D448308F272BA004A47F5 /* tclAppInit.c */, F96D448408F272BA004A47F5 /* tclConfig.sh.in */, F96D448608F272BA004A47F5 /* tclsh.rc */, F96D448708F272BA004A47F5 /* tclWin32Dll.c */, F96D448808F272BA004A47F5 /* tclWinChan.c */, |
︙ | ︙ |
Changes to macosx/tclMacOSXBundle.c.
1 2 3 4 5 6 | /* * tclMacOSXBundle.c -- * * This file implements functions that inspect CFBundle structures on * MacOS X. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclMacOSXBundle.c -- * * This file implements functions that inspect CFBundle structures on * MacOS X. * * Copyright © 2001-2009 Apple Inc. * Copyright © 2003-2009 Daniel A. Steffen <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclPort.h" #include "tclInt.h" |
︙ | ︙ |
Changes to macosx/tclMacOSXFCmd.c.
1 2 3 4 5 6 | /* * tclMacOSXFCmd.c * * This file implements the MacOSX specific portion of file manipulation * subcommands of the "file" command. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclMacOSXFCmd.c * * This file implements the MacOSX specific portion of file manipulation * subcommands of the "file" command. * * Copyright © 2003-2007 Daniel A. Steffen <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
637 638 639 640 641 642 643 | { const char *string; int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); size_t length; | | | 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 | { const char *string; int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); size_t length; string = Tcl_GetStringFromObj(objPtr, &length); Tcl_UtfToExternalDString(encoding, string, length, &ds); if (Tcl_DStringLength(&ds) > 4) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected Macintosh OS type but got \"%s\": ", string)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL); |
︙ | ︙ |
Changes to macosx/tclMacOSXNotify.c.
1 2 3 4 5 6 7 | /* * tclMacOSXNotify.c -- * * This file contains the implementation of a merged CFRunLoop/select() * based notifier, which is the lowest-level part of the Tcl event loop. * This file works together with generic/tclNotify.c. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclMacOSXNotify.c -- * * This file contains the implementation of a merged CFRunLoop/select() * based notifier, which is the lowest-level part of the Tcl event loop. * This file works together with generic/tclNotify.c. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 2001-2009, Apple Inc. * Copyright © 2005-2009 Daniel A. Steffen <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
235 236 237 238 239 240 241 | /* * Debug version of SpinLockLock that logs the time spent waiting for the lock */ #define SpinLockLockDbg(p) \ if (!SpinLockTry(p)) { \ | | | 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 | /* * Debug version of SpinLockLock that logs the time spent waiting for the lock */ #define SpinLockLockDbg(p) \ if (!SpinLockTry(p)) { \ long long s = TclpGetWideClicks(), e; \ \ SpinLockLock(p); \ e = TclpGetWideClicks(); \ TclMacOSXNotifierDbgMsg("waited on %s for %8.0f ns", \ #p, TclpWideClicksToNanoseconds(e-s)); \ } #undef LOCK_NOTIFIER_INIT |
︙ | ︙ | |||
530 531 532 533 534 535 536 | #define noCFafterFork 1 #endif /* MAC_OS_X_VERSION_MIN_REQUIRED */ #endif /* HAVE_PTHREAD_ATFORK */ /* *---------------------------------------------------------------------- * | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | < < < < < < | | 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 | #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) { | | > | | | | | 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 | 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) { | | | | | | | | 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 | * 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 |
︙ | ︙ | |||
696 697 698 699 700 701 702 | UNLOCK_NOTIFIER_INIT; return tsdPtr; } /* *---------------------------------------------------------------------- * | | | | 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 | UNLOCK_NOTIFIER_INIT; return tsdPtr; } /* *---------------------------------------------------------------------- * * Tcl_MacOSXNotifierAddRunLoopMode -- * * Add the tcl notifier RunLoop source, observer and timer (if any) * to the given RunLoop mode. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_MacOSXNotifierAddRunLoopMode( const void *runLoopMode) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); CFStringRef mode = (CFStringRef) runLoopMode; if (tsdPtr->runLoop) { CFRunLoopAddSource(tsdPtr->runLoop, tsdPtr->runLoopSource, mode); |
︙ | ︙ | |||
758 759 760 761 762 763 764 | 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, | | | | | | < < < < < < < | 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 | 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, (void * (*)(void *)) NotifierThreadProc, NULL); pthread_attr_destroy(&attr); if (result) { Tcl_Panic("StartNotifierThread: unable to start notifier thread"); } notifierThreadRunning = 1; } 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 |
︙ | ︙ | |||
872 873 874 875 876 877 878 | } UNLOCK_NOTIFIER_TSD; } /* *---------------------------------------------------------------------- * | | | | < < < < < | | < < < < < | | 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 | } 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)) { } /* *---------------------------------------------------------------------- * | | | | < < < < < < < | | | | | < < < < < < < < < < < < < | | 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 | 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 *) Tcl_Alloc(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; } /* *---------------------------------------------------------------------- * | | | | | < < < < < < < < < | | | < < < < | | | | 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 | } 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); | < | | < < < | 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 | * 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); } | < | | < < < | 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 | } if (mask & TCL_EXCEPTION) { FD_CLR(filePtr->fd, &tsdPtr->readyMasks.exceptional); } UNLOCK_NOTIFIER_TSD; filePtr->proc(filePtr->clientData, mask); } } return 1; } /* *---------------------------------------------------------------------- * * 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) { | | < | | | 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 | /* * 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; | | | 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 | 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) { | | > | | | > | 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 | /* * 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 *) Tcl_Alloc(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; | < | | 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 | /* * 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; |
︙ | ︙ | |||
1849 1850 1851 1852 1853 1854 1855 | * 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 | | | 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 | * 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. * *---------------------------------------------------------------------- */ |
︙ | ︙ | |||
2086 2087 2088 2089 2090 2091 2092 | static void AtForkChild(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* | | | | | 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 | 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) tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT; #else UNLOCK_NOTIFIER_TSD; UNLOCK_NOTIFIER; |
︙ | ︙ | |||
2134 2135 2136 2137 2138 2139 2140 | } } #endif /* HAVE_PTHREAD_ATFORK */ #else /* HAVE_COREFOUNDATION */ void | | | | 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 | } } #endif /* HAVE_PTHREAD_ATFORK */ #else /* HAVE_COREFOUNDATION */ void Tcl_MacOSXNotifierAddRunLoopMode( const void *runLoopMode) { Tcl_Panic("Tcl_MacOSXNotifierAddRunLoopMode: " "Tcl not built with CoreFoundation support"); } #endif /* HAVE_COREFOUNDATION */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to tests-perf/clock.perf.tcl.
1 2 3 4 5 6 7 8 9 10 11 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # test-performance.tcl -- # # This file provides common performance tests for comparison of tcl-speed # degradation by switching between branches. # (currently for clock ensemble only) # # ------------------------------------------------------------------------ # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # test-performance.tcl -- # # This file provides common performance tests for comparison of tcl-speed # degradation by switching between branches. # (currently for clock ensemble only) # # ------------------------------------------------------------------------ # # Copyright © 2014 Serg G. Brester (aka sebres) # # See the file "license.terms" for information on usage and redistribution # of this file. # array set in {-time 500} if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { |
︙ | ︙ |
Changes to tests-perf/test-performance.tcl.
1 2 3 4 5 6 7 8 9 10 11 | # ------------------------------------------------------------------------ # # test-performance.tcl -- # # This file provides common performance tests for comparison of tcl-speed # degradation or regression by switching between branches. # # To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl". # # ------------------------------------------------------------------------ # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # ------------------------------------------------------------------------ # # test-performance.tcl -- # # This file provides common performance tests for comparison of tcl-speed # degradation or regression by switching between branches. # # To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl". # # ------------------------------------------------------------------------ # # Copyright © 2014 Serg G. Brester (aka sebres) # # See the file "license.terms" for information on usage and redistribution # of this file. # namespace eval ::tclTestPerf { # warm-up interpeter compiler env, calibrate timerate measurement functionality: |
︙ | ︙ |
Changes to tests-perf/timer-event.perf.tcl.
1 2 3 4 5 6 7 8 9 10 11 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # timer-event.perf.tcl -- # # This file provides performance tests for comparison of tcl-speed # of timer events (event-driven tcl-handling). # # ------------------------------------------------------------------------ # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # timer-event.perf.tcl -- # # This file provides performance tests for comparison of tcl-speed # of timer events (event-driven tcl-handling). # # ------------------------------------------------------------------------ # # Copyright © 2014 Serg G. Brester (aka sebres) # # See the file "license.terms" for information on usage and redistribution # of this file. # if {![namespace exists ::tclTestPerf]} { |
︙ | ︙ |
Changes to tests/aaa_exit.test.
1 2 3 4 5 6 | # Commands covered: exit, emphasis on finalization hangs # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: exit, emphasis on finalization hangs # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/all.tcl.
1 2 3 4 5 6 | # all.tcl -- # # This file contains a top-level script to run all of the Tcl # tests. Execute it by invoking "source all.tcl" when running tcltest # in this directory. # | | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # all.tcl -- # # This file contains a top-level script to run all of the Tcl # tests. Execute it by invoking "source all.tcl" when running tcltest # in this directory. # # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2000 Ajuba Solutions # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package prefer latest package require tcltest 2.5 namespace import ::tcltest::* configure {*}$argv -testdir [file dirname [file dirname [file normalize [ info script]/...]]] if {[singleProcess]} { |
︙ | ︙ |
Changes to tests/append.test.
1 2 3 4 5 6 | # Commands covered: append lappend # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # Commands covered: append lappend # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 } {first firstsecond firstsecondthird firstsecondthird} test append-1.3 {append command} { set x "abcd" append x } abcd test append-2.1 {long appends} { set x "" for {set i 0} {$i < 1000} {incr i} { append x "foobar " } set y "foobar" set y "$y $y $y $y $y $y $y $y $y $y" set y "$y $y $y $y $y $y $y $y $y $y" set y "$y $y $y $y $y $y $y $y $y $y " expr {$x == $y} } 1 test append-3.1 {append errors} -returnCodes error -body { append } -result {wrong # args: should be "append varName ?value ...?"} test append-3.2 {append errors} -returnCodes error -body { 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 "" |
︙ | ︙ | |||
154 155 156 157 158 159 160 | test append-5.1 {long lappends} -setup { unset -nocomplain x proc check {var size} { set l [llength $var] if {$l != $size} { return "length mismatch: should have been $size, was $l" } | | | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | test append-5.1 {long lappends} -setup { unset -nocomplain x proc check {var size} { set l [llength $var] if {$l != $size} { return "length mismatch: should have been $size, was $l" } for {set i 0} {$i < $size} {incr i} { set j [lindex $var $i] if {$j ne "item $i"} { return "element $i should have been \"item $i\", was \"$j\"" } } return ok } |
︙ | ︙ |
Changes to tests/appendComp.test.
1 2 3 4 5 6 | # Commands covered: append lappend # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: append lappend # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
37 38 39 40 41 42 43 | } foo } abcd test appendComp-2.1 {long appends} { proc foo {} { set x "" | | | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | } foo } abcd test appendComp-2.1 {long appends} { proc foo {} { set x "" for {set i 0} {$i < 1000} {incr i} { append x "foobar " } set y "foobar" set y "$y $y $y $y $y $y $y $y $y $y" set y "$y $y $y $y $y $y $y $y $y $y" set y "$y $y $y $y $y $y $y $y $y $y " expr {$x == $y} |
︙ | ︙ | |||
219 220 221 222 223 224 225 | return "element $i should have been \"item $i\", was \"$j\"" } } return ok } } -body { set x "" | | | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 | return "element $i should have been \"item $i\", was \"$j\"" } } return ok } } -body { set x "" for {set i 0} {$i < 300} {incr i} { lappend x "item $i" } check $x 300 } -cleanup { unset -nocomplain x catch {rename check ""} } -result ok |
︙ | ︙ |
Changes to tests/apply.test.
1 2 3 4 5 6 | # Commands covered: apply # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # Commands covered: apply # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2005-2006 Miguel Sofer # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/assemble.test.
1 2 3 4 | # assemble.test -- # # Test suite for the 'tcl::unsupported::assemble' command # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | # assemble.test -- # # Test suite for the 'tcl::unsupported::assemble' command # # Copyright © 2010 Ozgur Dogan Ugurlu. # Copyright © 2010 Kevin B. Kenny. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. #----------------------------------------------------------------------------- # Commands covered: assemble |
︙ | ︙ |
Changes to tests/assocd.test.
1 2 3 4 5 6 | # This file tests the AssocData facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # This file tests the AssocData facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1994 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testgetassocdata [llength [info commands testgetassocdata]] testConstraint testsetassocdata [llength [info commands testsetassocdata]] testConstraint testdelassocdata [llength [info commands testdelassocdata]] test assocd-1.1 {testing setting assoc data} testsetassocdata { testsetassocdata a 1 |
︙ | ︙ |
Changes to tests/async.test.
1 2 3 4 5 6 | # Commands covered: none # # This file contains a collection of tests for Tcl_AsyncCreate and related # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # Commands covered: none # # This file contains a collection of tests for Tcl_AsyncCreate and related # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testasync [llength [info commands testasync]] testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}] proc async1 {result code} { global aresult acode set aresult $result set acode $code return "new result" } |
︙ | ︙ |
Changes to tests/autoMkindex.test.
1 2 3 4 5 | # Commands covered: auto_mkindex auto_import # # This file contains tests related to autoloading and generating the # autoloading index. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # Commands covered: auto_mkindex auto_import # # This file contains tests related to autoloading and generating the # autoloading index. # # Copyright © 1998 Lucent Technologies, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
28 29 30 31 32 33 34 | # proc another {args} { ... } # } # } # # Note that procedures and itcl class definitions can be nested inside of # namespaces. # | | | | | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | # proc another {args} { ... } # } # } # # Note that procedures and itcl class definitions can be nested inside of # namespaces. # # Copyright © 1993-1998 Lucent Technologies, Inc. # This shouldn't cause any problems namespace import -force blt::* # Should be able to handle "proc" definitions, even if they are preceded by # white space. proc normal {x y} {return [expr {$x+$y}]} proc indented {x y} {return [expr {$x+$y}]} # # Should be able to handle proc declarations within namespaces, even if they # have explicit namespace paths. # namespace eval buried { proc inside {args} {return "inside: $args"} |
︙ | ︙ |
Changes to tests/basic.test.
1 2 3 4 5 6 7 8 9 10 11 | # This file contains tests for the tclBasic.c source file. Tests appear in # the same order as the C code that they test. The set of tests is # currently incomplete since it currently includes only new tests for # code changed for the addition of Tcl namespaces. Other variable- # related tests appear in several other test files including # assocd.test, cmdInfo.test, eval.test, expr.test, interp.test, # and trace.test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | # This file contains tests for the tclBasic.c source file. Tests appear in # the same order as the C code that they test. The set of tests is # currently incomplete since it currently includes only new tests for # code changed for the addition of Tcl namespaces. Other variable- # related tests appear in several other test files including # assocd.test, cmdInfo.test, eval.test, expr.test, interp.test, # and trace.test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testevalex [llength [info commands testevalex]] testConstraint testcmdtoken [llength [info commands testcmdtoken]] testConstraint testcreatecommand [llength [info commands testcreatecommand]] testConstraint exec [llength [info commands exec]] catch {namespace delete test_ns_basic} |
︙ | ︙ | |||
670 671 672 673 674 675 676 | proc l3 {} { list i j k {l l} } # Do all tests once byte compiled and once with direct string evaluation foreach noComp {0 1} { | | | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 | proc l3 {} { list i j k {l l} } # Do all tests once byte compiled and once with direct string evaluation foreach noComp {0 1} { if {$noComp} { interp alias {} run {} testevalex set constraints testevalex } else { interp alias {} run {} if 1 set constraints {} } |
︙ | ︙ |
Changes to tests/binary.test.
1 2 3 4 5 6 | # This file tests the tclBinary.c file and the "binary" Tcl command. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | > > > | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # This file tests the tclBinary.c file and the "binary" Tcl command. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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" |
︙ | ︙ | |||
755 756 757 758 759 760 761 | list [binary scan "abc def \x00 " A* arg1] $arg1 } -result {1 {abc def}} test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan "abc def \x00ghi " A* arg1] $arg1 } -result [list 1 "abc def \x00ghi"] | | > > > > > > > > > | 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 | list [binary scan "abc def \x00 " A* arg1] $arg1 } -result {1 {abc def}} test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan "abc def \x00ghi " A* arg1] $arg1 } -result [list 1 "abc def \x00ghi"] test binary-21.13 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan "abc def \x00 " C* arg1] $arg1 } -result {1 {abc def }} test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan "abc def \x00ghi" C* arg1] $arg1 } -result {1 {abc def }} test binary-22.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { binary scan abc b } -result {not enough arguments for all format specifiers} test binary-22.2 {Tcl_BinaryObjCmd: scan} { unset -nocomplain arg1 list [binary scan \x52\x53 b* arg1] $arg1 } {1 0100101011001010} |
︙ | ︙ | |||
861 862 863 864 865 866 867 | } -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 |
︙ | ︙ | |||
907 908 909 910 911 912 913 | } -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 |
︙ | ︙ | |||
952 953 954 955 956 957 958 | } {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} |
︙ | ︙ | |||
1530 1531 1532 1533 1534 1535 1536 | 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} |
︙ | ︙ | |||
1614 1615 1616 1617 1618 1619 1620 | 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 |
︙ | ︙ | |||
1700 1701 1702 1703 1704 1705 1706 | } {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 |
︙ | ︙ | |||
1885 1886 1887 1888 1889 1890 1891 | 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:]]+\))?} |
︙ | ︙ | |||
2483 2484 2485 2486 2487 2488 2489 | 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 { |
︙ | ︙ | |||
2559 2560 2561 2562 2563 2564 2565 | 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} |
︙ | ︙ | |||
2631 2632 2633 2634 2635 2636 2637 | 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 |
︙ | ︙ | |||
2778 2779 2780 2781 2782 2783 2784 | 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 |
︙ | ︙ | |||
2829 2830 2831 2832 2833 2834 2835 | 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 { |
︙ | ︙ | |||
2935 2936 2937 2938 2939 2940 2941 | 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.
1 2 3 4 | # This file contains a collection of tests for the Tcl built-in 'chan' # command. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 | # This file contains a collection of tests for the Tcl built-in 'chan' # command. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright © 2005 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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.
1 2 3 4 5 6 7 8 | # -*- tcl -*- # Functionality covered: operation of all IO commands, and all procedures # defined in generic/tclIO.c. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # -*- tcl -*- # Functionality covered: operation of all IO commands, and all procedures # defined in generic/tclIO.c. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1994 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
32 33 34 35 36 37 38 | variable n variable v variable msg variable expected catch { ::tcltest::loadTestedCommands | | | > | | 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 | variable n variable v variable msg variable expected catch { ::tcltest::loadTestedCommands package require -exact tcl::test [info patchlevel] set ::tcltestlib [info loaded {} Tcltest] } package require tcltests testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] 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 |
︙ | ︙ | |||
74 75 76 77 78 79 80 | chan close $f set path(cat) [makeFile { set f stdin if {$argv != ""} { set f [open [lindex $argv 0]] } | | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | 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 |
︙ | ︙ | |||
110 111 112 113 114 115 116 | 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 | | | | | | | 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 | 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 |
︙ | ︙ | |||
268 269 270 271 272 273 274 | 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 | | | | | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 | 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 |
︙ | ︙ | |||
416 417 418 419 420 421 422 | 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 | | | | | 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 | 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 |
︙ | ︙ | |||
462 463 464 465 466 467 468 | 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] | | | | | | 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 | 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] |
︙ | ︙ | |||
860 861 862 863 864 865 866 | 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 | | | | 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 | 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 "" |
︙ | ︙ | |||
914 915 916 917 918 919 920 | 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 | | | 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 | 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] |
︙ | ︙ | |||
980 981 982 983 984 985 986 | } -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 | | | | 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 | } -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] |
︙ | ︙ | |||
1011 1012 1013 1014 1015 1016 1017 | } -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 | | | | 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 | } -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" |
︙ | ︙ | |||
1052 1053 1054 1055 1056 1057 1058 | 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 | | | | | | | | | 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 | 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 |
︙ | ︙ | |||
1200 1201 1202 1203 1204 1205 1206 | } -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] | | | 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 | } -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 { } {} |
︙ | ︙ | |||
1356 1357 1358 1359 1360 1361 1362 | 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 | | | | | | 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 | 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 } |
︙ | ︙ | |||
1396 1397 1398 1399 1400 1401 1402 | 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 | | | 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 | 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)] |
︙ | ︙ | |||
1525 1526 1527 1528 1529 1530 1531 | 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 { | | | | 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 | 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 |
︙ | ︙ | |||
1873 1874 1875 1876 1877 1878 1879 | 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 | | | | 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 | 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 { set path(stdout) [makeFile {} stdout] } -constraints {stdio notWinCI} -body { set f [open $path(script) w] chan puts -nonewline $f { chan close stdout set f1 [} chan puts $f [list open $path(stdout) w]] chan puts $f { chan configure $f1 -buffersize 777 |
︙ | ︙ | |||
2792 2793 2794 2795 2796 2797 2798 | variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } | | | 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 | variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } } -constraints {socket tempNotMac fileevent notWinCI} -body { proc accept {s a p} { variable x chan event $s readable [namespace code [list readit $s]] chan configure $s -blocking off set x accepted } proc readit {s} { |
︙ | ︙ | |||
3046 3047 3048 3049 3050 3051 3052 | } chan close $f set f [open $path(test1) r] chan configure $f -translation auto string length [chan read $f] } -cleanup { chan close $f | | | | 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 | } chan close $f set f [open $path(test1) r] chan configure $f -translation auto string length [chan read $f] } -cleanup { chan close $f } -result [expr {700*15 + 1}] test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf chan puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { chan puts $f $line } chan close $f set f [open $path(test1) r] chan configure $f -translation crlf string length [chan read $f] } -cleanup { chan close $f } -result [expr {700*15 + 1}] test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\rhere chan close $f |
︙ | ︙ | |||
3086 3087 3088 3089 3090 3091 3092 | 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 | | | | | | | | 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 | 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] |
︙ | ︙ | |||
3178 3179 3180 3181 3182 3183 3184 | 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 | | | | | | | | | | | 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 | 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. |
︙ | ︙ | |||
3644 3645 3646 3647 3648 3649 3650 | 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] | | | | < | | | 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 | 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 |
︙ | ︙ | |||
3733 3734 3735 3736 3737 3738 3739 | 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 | | | 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 | 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] |
︙ | ︙ | |||
3755 3756 3757 3758 3759 3760 3761 | 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 | | | 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 | 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] |
︙ | ︙ | |||
3777 3778 3779 3780 3781 3782 3783 | 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 | | | | | | | | | 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 | 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 |
︙ | ︙ | |||
3905 3906 3907 3908 3909 3910 3911 | set f [open $path(test1) r] chan configure $f -translation crlf while {[chan gets $f line] >= 0} { append c $line\n } chan close $f string length $c | | | | 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 | set f [open $path(test1) r] chan configure $f -translation crlf while {[chan gets $f line] >= 0} { append c $line\n } chan close $f string length $c } -result [expr {700*15 + 1}] test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup { file delete $path(test1) set c "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf chan puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { chan puts $f $line } chan close $f set f [open $path(test1) r] chan configure $f -translation auto while {[chan gets $f line] >= 0} { append c $line\n } chan close $f string length $c } -result [expr {700*15 + 1}] # Test Tcl_Read and buffering. test chan-io-32.1 {Tcl_Read, channel not readable} -body { read stdout } -returnCodes error -result {channel "stdout" wasn't opened for reading} test chan-io-32.2 {Tcl_Read, zero byte count} { |
︙ | ︙ | |||
4633 4634 4635 4636 4637 4638 4639 | } -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] | | | | | | | | | | | | | | | | | | | | 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 | } -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 |
︙ | ︙ | |||
5162 5163 5164 5165 5166 5167 5168 | 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 {} | | | | | | | | 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 | 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 |
︙ | ︙ | |||
5334 5335 5336 5337 5338 5339 5340 | lappend x [chan gets $f] } -cleanup { chan close $f } -result {zzy abzzy} test chan-io-40.2 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -constraints {unix} -body { | | | | | | 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 | lappend x [chan gets $f] } -cleanup { chan close $f } -result {zzy abzzy} test chan-io-40.2 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -constraints {unix} -body { set f [open $path(test3) {WRONLY CREAT} 0o600] file stat $path(test3) stats set x [format 0o%03o [expr {$stats(mode) & 0o777}]] chan puts $f "line 1" chan close $f set f [open $path(test3) r] lappend x [chan gets $f] } -cleanup { chan close $f } -result {0o600 {line 1}} test chan-io-40.3 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -constraints {unix umask} -body { # This test only works if your umask is 2, like ouster's. chan close [open $path(test3) {WRONLY CREAT}] file stat $path(test3) stats format 0o%03o [expr {$stats(mode) & 0o777}] } -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]] test chan-io-40.4 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan configure $f -eofchar {} chan puts $f xyzzy chan close $f |
︙ | ︙ | |||
5528 5529 5530 5531 5532 5533 5534 | 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 {} | | | | | 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 | 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 {} |
︙ | ︙ | |||
5978 5979 5980 5981 5982 5983 5984 | 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] | | | 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 | 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 |
︙ | ︙ | |||
6002 6003 6004 6005 6006 6007 6008 | 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] | | | 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 | 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 |
︙ | ︙ | |||
6026 6027 6028 6029 6030 6031 6032 | 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] | | | 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 | 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 |
︙ | ︙ | |||
6050 6051 6052 6053 6054 6055 6056 | 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] | | | 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 | 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 |
︙ | ︙ | |||
6074 6075 6076 6077 6078 6079 6080 | 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] | | | 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 | 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 |
︙ | ︙ | |||
6098 6099 6100 6101 6102 6103 6104 | 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] | | | 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 | 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 |
︙ | ︙ | |||
6122 6123 6124 6125 6126 6127 6128 | 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] | | | 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 | 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 |
︙ | ︙ | |||
6146 6147 6148 6149 6150 6151 6152 | 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] | | | 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 | 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 |
︙ | ︙ | |||
6170 6171 6172 6173 6174 6175 6176 | 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] | | | 6170 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 6184 | 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 |
︙ | ︙ | |||
6194 6195 6196 6197 6198 6199 6200 | 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] | | | 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 | 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 |
︙ | ︙ | |||
6218 6219 6220 6221 6222 6223 6224 | 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] | | | 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 | 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 |
︙ | ︙ | |||
6242 6243 6244 6245 6246 6247 6248 | 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] | | | 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 | 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 |
︙ | ︙ | |||
6497 6498 6499 6500 6501 6502 6503 | testchannelevent $f delete 0 lappend z "del deleted notcalled" lappend z "del deleted myself" } else { set u recursive lappend z "del calling recursive" set timer [after 50 lappend z timeout] | | | | 6497 6498 6499 6500 6501 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 | testchannelevent $f delete 0 lappend z "del deleted notcalled" lappend z "del deleted myself" } else { set u recursive lappend z "del calling recursive" set timer [after 50 lappend z timeout] set mode [testservicemode 1] vwait z after cancel $timer testservicemode $mode lappend z "del after update" } } set z "" set u toplevel set timer [after 50 lappend z timeout] testservicemode 0 |
︙ | ︙ | |||
6717 6718 6719 6720 6721 6722 6723 | test chan-io-52.6 {TclCopyChannel} -setup { file delete $path(test1) } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -blocking 0 chan configure $f2 -translation lf -blocking 0 | | | 6717 6718 6719 6720 6721 6722 6723 6724 6725 6726 6727 6728 6729 6730 6731 | test chan-io-52.6 {TclCopyChannel} -setup { file delete $path(test1) } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -blocking 0 chan configure $f2 -translation lf -blocking 0 set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]] set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 chan close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {($s1 == $s2) && ($s0 == $s1)} { lappend result ok |
︙ | ︙ | |||
6779 6780 6781 6782 6783 6784 6785 | # 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 | | | 6779 6780 6781 6782 6783 6784 6785 6786 6787 6788 6789 6790 6791 6792 6793 | # 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 |
︙ | ︙ | |||
6817 6818 6819 6820 6821 6822 6823 | 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 | | | 6817 6818 6819 6820 6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 6831 | 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 |
︙ | ︙ | |||
6959 6960 6961 6962 6963 6964 6965 | set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0] set in [open $thisScript] ;# 126 K set out [socket 127.0.0.1 [lindex [chan configure $listen -sockname] 2]] catch {unset fcopyTestDone} chan close $listen ;# This means the socket open never really succeeds chan copy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone | | | | 6959 6960 6961 6962 6963 6964 6965 6966 6967 6968 6969 6970 6971 6972 6973 6974 6975 6976 6977 6978 6979 6980 6981 6982 6983 6984 6985 6986 6987 6988 6989 6990 6991 6992 6993 | set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0] set in [open $thisScript] ;# 126 K set out [socket 127.0.0.1 [lindex [chan configure $listen -sockname] 2]] catch {unset fcopyTestDone} chan close $listen ;# This means the socket open never really succeeds chan copy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g. } chan close $in chan close $out set fcopyTestDone ;# 1 for error condition } 1 test chan-io-53.6 {CopyData: error during chan copy} -setup { variable fcopyTestDone file delete $path(pipe) file delete $path(test1) catch {unset fcopyTestDone} } -constraints {stdio fcopy} -body { set f1 [open $path(pipe) w] chan puts $f1 "exit 1" chan close $f1 set in [openpipe r+ $path(pipe)] set out [open $path(test1) w] chan copy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } return $fcopyTestDone ;# 0 for plain end of file } -cleanup { catch {chan close $in} chan close $out } -result 0 |
︙ | ︙ | |||
7032 7033 7034 7035 7036 7037 7038 | set out [open $path(test1) w] doFcopy $in $out variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } # -1=error 0=script error N=number of bytes | | | 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046 | set out [open $path(test1) w] doFcopy $in $out variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } # -1=error 0=script error N=number of bytes expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1} } -cleanup { catch {chan close $in} chan close $out } -result {3450} test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { # copy progress callback. errors out intentionally proc cmd args { |
︙ | ︙ | |||
7491 7492 7493 7494 7495 7496 7497 | } {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 { | | | 7491 7492 7493 7494 7495 7496 7497 7498 7499 7500 7501 7502 7503 7504 7505 | } {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] |
︙ | ︙ |
Changes to tests/clock.test.
1 2 3 4 5 6 7 8 | # clock.test -- # # This test file covers the 'clock' command that manipulates time. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # clock.test -- # # This test file covers the 'clock' command that manipulates time. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 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. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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} } { |
︙ | ︙ | |||
35432 35433 35434 35435 35436 35437 35438 | set problems } {} # Legacy tests # clock clicks test clock-33.1 {clock clicks tests} { | | | | | | 35432 35433 35434 35435 35436 35437 35438 35439 35440 35441 35442 35443 35444 35445 35446 35447 35448 35449 35450 35451 35452 35453 35454 35455 35456 35457 35458 35459 35460 35461 35462 35463 35464 35465 35466 35467 35468 35469 35470 35471 35472 35473 35474 35475 35476 35477 35478 35479 35480 35481 35482 35483 35484 35485 35486 35487 35488 35489 35490 35491 35492 35493 35494 35495 35496 | set problems } {} # Legacy tests # clock clicks test clock-33.1 {clock clicks tests} { expr {[clock clicks] + 1} concat {} } {} test clock-33.2 {clock clicks tests} { set start [clock clicks] after 10 set end [clock clicks] expr {$end > $start} } {1} test clock-33.3 {clock clicks tests} { list [catch {clock clicks foo} msg] $msg } {1 {bad option "foo": must be -milliseconds or -microseconds}} test clock-33.4 {clock clicks tests} { expr {[clock clicks -milliseconds] + 1} concat {} } {} test clock-33.4a {clock milliseconds} { expr { [clock milliseconds] + 1 } concat {} } {} test clock-33.5 {clock clicks tests, millisecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. if {[lindex [timerate { set start [clock clicks -milli] timerate {} 10; # short but precise busy wait set end [clock clicks -milli] } 1 1] 0] > 60000} { ::tcltest::Skip "timing issue" } # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end > $start) && (($end - $start) <= 60) ? "ok" : "test should have taken 0-60 ms, actually took [expr {$end - $start}]"} } {ok} test clock-33.5a {clock tests, millisecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. if {[lindex [timerate { set start [clock milliseconds] timerate {} 10; # short but precise busy wait set end [clock milliseconds] } 1 1] 0] > 60000} { ::tcltest::Skip "timing issue" } # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end > $start) && (($end - $start) <= 60) ? "ok" : "test should have taken 0-60 ms, actually took [expr {$end - $start}]"} } {ok} test clock-33.6 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks ? } msg] $msg } {1 {bad option "?": must be -milliseconds or -microseconds}} test clock-33.7 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks - } msg] $msg } {1 {ambiguous option "-": must be -milliseconds or -microseconds}} |
︙ | ︙ | |||
35901 35902 35903 35904 35905 35906 35907 | test clock-34.68 {clock scan tests (merid and TZ)} { set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 24,1970 21:59:00 GMT} # clock seconds test clock-35.1 {clock seconds tests} { | | | 35901 35902 35903 35904 35905 35906 35907 35908 35909 35910 35911 35912 35913 35914 35915 | test clock-34.68 {clock scan tests (merid and TZ)} { set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 24,1970 21:59:00 GMT} # clock seconds test clock-35.1 {clock seconds tests} { expr {[clock seconds] + 1} concat {} } {} test clock-35.2 {clock seconds tests} { list [catch {clock seconds foo} msg] $msg } {1 {wrong # args: should be "clock seconds"}} test clock-35.3 {clock seconds tests} { set start [clock seconds] |
︙ | ︙ | |||
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 \ |
︙ | ︙ | |||
36926 36927 36928 36929 36930 36931 36932 | clock format -0x8000000000000001 -format %s -gmt true } -result {integer value too large to represent} -returnCodes error } test clock-61.3 {near-miss overflow of a wide integer on output} { clock format 0x7fffffffffffffff -format %s -gmt true | | | | 36926 36927 36928 36929 36930 36931 36932 36933 36934 36935 36936 36937 36938 36939 36940 36941 36942 36943 | clock format -0x8000000000000001 -format %s -gmt true } -result {integer value too large to represent} -returnCodes error } test clock-61.3 {near-miss overflow of a wide integer on output} { clock format 0x7fffffffffffffff -format %s -gmt true } [expr {0x7fffffffffffffff}] test clock-61.4 {near-miss overflow of a wide integer on output} { clock format -0x8000000000000000 -format %s -gmt true } [expr {-0x8000000000000000}] test clock-62.1 {Bug 1902423} {*}{ -setup {::tcl::clock::ClearCaches} -body { set s 1204049747 set f1 [clock format $s -format {%Y-%m-%d %T} -locale C] set f2 [clock format $s -format {%Y-%m-%d %H:%M:%S} -locale C] |
︙ | ︙ |
Changes to tests/cmdAH.test.
1 2 3 4 5 6 | # The file tests the tclCmdAH.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | # The file tests the tclCmdAH.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1996-1998 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint linkDirectory [expr { ![testConstraint win] || ($::tcl_platform(osVersion) >= 5.0 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] global env set cmdAHwd [pwd] catch {set platform [testgetplatform]} proc waitForEvenSecondForFAT {} { # Windows 9x uses filesystems (the FAT* family of FSes) without enough |
︙ | ︙ | |||
139 140 141 142 143 144 145 | pwd } -cleanup { cd $dir } -result {/} test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup { set dir [pwd] } -returnCodes error -body { | | | | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | 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} { |
︙ | ︙ | |||
176 177 178 179 180 181 182 | 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 | | | | | | 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 | 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 { |
︙ | ︙ | |||
956 957 958 959 960 961 962 | # the stuff below correctly. test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup { file delete -force /tmp/tcl.foo.dir/file file delete -force /tmp/tcl.foo.dir } -body { makeDirectory /tmp/tcl.foo.dir makeFile 12345 /tmp/tcl.foo.dir/file | | | | 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 | # the stuff below correctly. test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup { file delete -force /tmp/tcl.foo.dir/file file delete -force /tmp/tcl.foo.dir } -body { makeDirectory /tmp/tcl.foo.dir makeFile 12345 /tmp/tcl.foo.dir/file file attributes /tmp/tcl.foo.dir -permissions 0 file exists /tmp/tcl.foo.dir/file } -cleanup { file attributes /tmp/tcl.foo.dir -permissions 0o775 removeFile /tmp/tcl.foo.dir/file removeDirectory /tmp/tcl.foo.dir } -result 0 test cmdAH-19.12 {Bug 3608360: [file exists] mustn't do globbing} -setup { set newdirfile [makeDirectory newdir.file] set cwd [pwd] cd $newdirfile |
︙ | ︙ | |||
982 983 984 985 986 987 988 | } -result {1 0} # Stat related commands catch {testsetplatform $platform} removeFile $gorpfile set gorpfile [makeFile "Test string" gorp.file] | | | 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 | } -result {1 0} # Stat related commands catch {testsetplatform $platform} removeFile $gorpfile set gorpfile [makeFile "Test string" gorp.file] catch {file attributes $gorpfile -permissions 0o765} # avoid problems with non-local filesystems if {[testConstraint unix] && [file exists /tmp]} { set file [makeFile "data" touch.me /tmp] } else { set file [makeFile "data" touch.me] } |
︙ | ︙ | |||
1083 1084 1085 1086 1087 1088 1089 | file lstat $linkfile stat lsort [array names stat] } -result {atime ctime dev gid ino mode mtime nlink size type uid} test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup { unset -nocomplain stat } -constraints {unix nonPortable} -body { file lstat $linkfile stat | | | 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 | file lstat $linkfile stat lsort [array names stat] } -result {atime ctime dev gid ino mode mtime nlink size type uid} test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup { unset -nocomplain stat } -constraints {unix nonPortable} -body { file lstat $linkfile stat list $stat(nlink) [expr {$stat(mode) & 0o777}] $stat(type) } -result {1 511 link} test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} { list [catch {file lstat _bogus_ stat} msg] [string tolower $msg] \ $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup { unset -nocomplain x |
︙ | ︙ | |||
1211 1212 1213 1214 1215 1216 1217 | 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. | | | 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 | 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"} |
︙ | ︙ | |||
1236 1237 1238 1239 1240 1241 1242 | 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. | | | 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 | 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"} |
︙ | ︙ | |||
1398 1399 1400 1401 1402 1403 1404 | } set res } -result 0 catch {testsetplatform $platform} removeFile $gorpfile set gorpfile [makeFile "Test string" gorp.file] | | | 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 | } set res } -result 0 catch {testsetplatform $platform} removeFile $gorpfile set gorpfile [makeFile "Test string" gorp.file] catch {file attributes $gorpfile -permissions 0o765} # stat test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body { file stat _bogus_ } -result {wrong # args: should be "file stat name varName"} test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body { file stat _bogus_ a b |
︙ | ︙ | |||
1425 1426 1427 1428 1429 1430 1431 | file stat $gorpfile stat list $stat(nlink) $stat(size) $stat(type) } -result {1 12 file} test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup { unset -nocomplain stat } -body { file stat $gorpfile stat | | | | 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 | file stat $gorpfile stat list $stat(nlink) $stat(size) $stat(type) } -result {1 12 file} test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup { unset -nocomplain stat } -body { file stat $gorpfile stat format 0o%03o [expr {$stat(mode) & 0o777}] } -result 0o765 test cmdAH-28.6 {Tcl_FileObjCmd: stat} { list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-28.7 {Tcl_FileObjCmd: stat} -setup { unset -nocomplain x } -returnCodes error -body { set x 44 |
︙ | ︙ | |||
1762 1763 1764 1765 1766 1767 1768 | # cleanup catch {testsetplatform $platform} unset -nocomplain platform # Tcl_ForObjCmd is tested in for.test | | | 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 | # cleanup catch {testsetplatform $platform} unset -nocomplain platform # Tcl_ForObjCmd is tested in for.test catch {file attributes $dirfile -permissions 0o777} removeDirectory $dirfile removeFile $gorpfile # No idea how well [removeFile] copes with links... file delete $linkfile cd $cmdAHwd ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/cmdIL.test.
1 2 3 4 | # This file contains a collection of tests for the procedures in the file # tclCmdIL.c. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # This file contains a collection of tests for the procedures in the file # tclCmdIL.c. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] source [file join [file dirname [info script]] internals.tcl] namespace import -force ::tcltest::internals::* |
︙ | ︙ | |||
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} |
︙ | ︙ | |||
510 511 512 513 514 515 516 | } {{dogs {0 1}} {the {0 1 2} lazy} {jumps {30 31 2 33} over} {brown {0 1 2 3 4} fox} {the {0 1 2 3 4 5} quick}} test cmdIL-5.5 {lsort with list style index and sharing} -body { proc test_lsort {l} { set n $l foreach e $l {lappend n [list [expr {rand()}] $e]} lindex [lsort -real -index $l $n] 1 1 } | | | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 | } {{dogs {0 1}} {the {0 1 2} lazy} {jumps {30 31 2 33} over} {brown {0 1 2 3 4} fox} {the {0 1 2 3 4 5} quick}} test cmdIL-5.5 {lsort with list style index and sharing} -body { proc test_lsort {l} { set n $l foreach e $l {lappend n [list [expr {rand()}] $e]} lindex [lsort -real -index $l $n] 1 1 } expr {srand(1)} test_lsort 0 } -result 0 -cleanup { rename test_lsort "" } test cmdIL-5.6 {lsort with multiple list-style index options} { lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}} } {{a b} {b e} {c d}} |
︙ | ︙ |
Changes to tests/cmdInfo.test.
1 2 3 4 5 6 7 8 | # Commands covered: none # # This file contains a collection of tests for Tcl_GetCommandInfo, # Tcl_SetCommandInfo, Tcl_CreateCommand, Tcl_DeleteCommand, and # Tcl_NameOfCommand. Sourcing this file into Tcl runs the tests # and generates output for errors. No output means no errors were # found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # Commands covered: none # # This file contains a collection of tests for Tcl_GetCommandInfo, # Tcl_SetCommandInfo, Tcl_CreateCommand, Tcl_DeleteCommand, and # Tcl_NameOfCommand. Sourcing this file into Tcl runs the tests # and generates output for errors. No output means no errors were # found. # # Copyright © 1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testcmdinfo [llength [info commands testcmdinfo]] testConstraint testcmdtoken [llength [info commands testcmdtoken]] test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 testcmdinfo get x1 |
︙ | ︙ |
Changes to tests/cmdMZ.test.
1 2 3 4 5 6 | # The tests in this file cover the procedures in tclCmdMZ.c. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # The tests in this file cover the procedures in tclCmdMZ.c. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
55 56 57 58 59 60 61 | file delete -force $foodir file mkdir $foodir cd $foodir } -constraints {unix nonPortable} -body { # This test fails on various unix platforms (eg Linux) where permissions # caching causes this to fail. The caching is strictly incorrect, but we # have no control over that. | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | file delete -force $foodir file mkdir $foodir cd $foodir } -constraints {unix nonPortable} -body { # This test fails on various unix platforms (eg Linux) where permissions # caching causes this to fail. The caching is strictly incorrect, but we # have no control over that. file attr . -permissions 0 pwd } -returnCodes error -cleanup { cd $cwd file delete -force $foodir } -result {error getting working directory name: permission denied} # The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.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.
1 2 3 4 5 6 7 8 | # Commands covered: expr # # This file contains the original set of tests for the compilation (and # indirectly execution) of Tcl's expr command. A new set of tests covering # the new implementation are in the files "parseExpr.test" and # "compExpr.test". Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # | | | | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 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 | # Commands covered: expr # # This file contains the original set of tests for the compilation (and # indirectly execution) of Tcl's expr command. A new set of tests covering # the new implementation are in the files "parseExpr.test" and # "compExpr.test". Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright © 1996-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands # 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 } |
︙ | ︙ |
Changes to tests/compExpr.test.
1 2 3 4 | # This file contains a collection of tests for the procedures in the file # tclCompExpr.c. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | # This file contains a collection of tests for the procedures in the file # tclCompExpr.c. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
303 304 305 306 307 308 309 | expr {0? 42 : $a} } -result 83 test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} { list [catch {expr {1? 15 : [expr *2]}} msg] $msg } {0 15} test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { | | | | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 | expr {0? 42 : $a} } -result 83 test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} { list [catch {expr {1? 15 : [expr *2]}} msg] $msg } {0 15} test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { format %.6g [expr {atan2(1.0, 2.0)}] } 0.463648 test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body { expr {do_it()} } -returnCodes error -match glob -result {* "*do_it"} test compExpr-5.5 {CompileMathFuncCall procedure, not enough arguments} -body { expr {atan2(1.0)} } -returnCodes error -match glob -result {not enough arguments for math function*} test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} { format %.6g [expr {pow(2.1, 27.5-(24.4*(5%2)))}] } 9.97424 test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body { expr {sinh(2.*)} } -returnCodes error -match glob -result * test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} -body { expr {sinh(2.0, 3.0)} } -returnCodes error -match glob -result {too many arguments for math function*} |
︙ | ︙ | |||
366 367 368 369 370 371 372 | set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { unset end i tmp rename getbytes {} } -result 0 | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -cleanup { unset end i tmp rename getbytes {} } -result 0 proc extract {opcodes descriptor} { set instructions [dict values [dict get $descriptor instructions]] return [lmap i $instructions { if {[lindex $i 0] in $opcodes} {string cat $i} else continue }] } test compExpr-8.1 {TIP 582: expression comments} -setup {} -body { extract {loadStk add} [tcl::unsupported::getbytecode script {expr { $abc # + $def + $ghi }}] } -result {loadStk loadStk add} test compExpr-8.2 {TIP 582: expression comments} -setup {} -body { extract {loadStk add} [tcl::unsupported::getbytecode script {expr { $abc # + $def # + $ghi }}] } -result loadStk test compExpr-8.3 {TIP 582: expression comments} -setup {} -body { extract {loadStk add} [tcl::unsupported::getbytecode script {expr { $abc # + $def\ + $ghi }}] } -result loadStk test compExpr-8.4 {TIP 582: expression comments} -setup {} -body { extract {loadStk add} [tcl::unsupported::getbytecode script {expr { $abc # + $def\\ + $ghi }}] } -result {loadStk loadStk add} # cleanup catch {unset a} catch {unset b} catch {rename extract ""} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: |
Changes to tests/compile.test.
1 2 3 4 5 6 7 | # This file contains tests for the files tclCompile.c, tclCompCmds.c and # tclLiteral.c # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | # This file contains tests for the files tclCompile.c, tclCompCmds.c and # tclLiteral.c # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint exec [llength [info commands exec]] testConstraint memory [llength [info commands memory]] testConstraint testevalex [llength [info commands testevalex]] # The following tests are very incomplete, although the rest of the # test suite covers this file fairly well. |
︙ | ︙ | |||
200 201 202 203 204 205 206 | -cleanup {namespace delete catchtest} } test compile-4.1 {TclCompileForCmd: command substituted test expression} { set i 0 set j 0 # Should be "forever" | | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 | -cleanup {namespace delete catchtest} } test compile-4.1 {TclCompileForCmd: command substituted test expression} { set i 0 set j 0 # Should be "forever" for {} [expr {$i < 3}] {} { set j [incr i] if {$j > 3} break } set j } {4} test compile-5.1 {TclCompileForeachCmd: exception stack} { |
︙ | ︙ | |||
274 275 276 277 278 279 280 | list $::x $::test_ns_compile::arr(1) } -result {hello 123} test compile-7.1 {TclCompileWhileCmd: command substituted test expression} { set i 0 set j 0 # Should be "forever" | | | | | 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 | list $::x $::test_ns_compile::arr(1) } -result {hello 123} test compile-7.1 {TclCompileWhileCmd: command substituted test expression} { set i 0 set j 0 # Should be "forever" while [expr {$i < 3}] { 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 {} { |
︙ | ︙ | |||
333 334 335 336 337 338 339 | test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; incr foo bar baz}} } -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; incr}} } -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { | | | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 | test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; incr foo bar baz}} } -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; incr}} } -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; expr [concat !a] }} } -returnCodes error -match glob -result * test compile-11.8 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; expr {!a} }} } -returnCodes error -match glob -result * test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; llength "\{" }} list [catch {p} msg] $msg |
︙ | ︙ | |||
562 563 564 565 566 567 568 | test compile-15.5 {proper TCL_RETURN code from [return]} { apply {{} {catch {set a 1}; return}} } "" # Do all tests once byte compiled and once with direct string evaluation foreach noComp {0 1} { | | | 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 | test compile-15.5 {proper TCL_RETURN code from [return]} { apply {{} {catch {set a 1}; return}} } "" # Do all tests once byte compiled and once with direct string evaluation foreach noComp {0 1} { if {$noComp} { interp alias {} run {} testevalex set constraints testevalex } else { interp alias {} run {} if 1 set constraints {} } |
︙ | ︙ |
Changes to tests/concat.test.
1 2 3 4 5 6 | # Commands covered: concat # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: concat # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/config.test.
1 2 3 4 5 6 7 | # -*- tcl -*- # Commands covered: pkgconfig # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # -*- tcl -*- # Commands covered: pkgconfig # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 {64bit bindir,install bindir,runtime compile_debug compile_stats debug*docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded} 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.
1 2 3 4 5 6 | # Commands covered: coroutine, yield, yieldto, [info coroutine] # # This file contains a collection of tests for experimental commands that are # found in ::tcl::unsupported. The tests will migrate to normal test files # if/when the commands find their way into the core. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # Commands covered: coroutine, yield, yieldto, [info coroutine] # # This file contains a collection of tests for experimental commands that are # found in ::tcl::unsupported. The tests will migrate to normal test files # if/when the commands find their way into the core. # # Copyright © 2008 Miguel Sofer. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testnrelevels [llength [info commands testnrelevels]] testConstraint memory [llength [info commands memory]] set lambda [list {{start 0} {stop 10}} { # init set i $start |
︙ | ︙ |
Changes to tests/dcall.test.
1 2 3 4 5 6 | # Commands covered: none # # This file contains a collection of tests for Tcl_CallWhenDeleted. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: none # # This file contains a collection of tests for Tcl_CallWhenDeleted. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright © 1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testdcall [llength [info commands testdcall]] test dcall-1.1 {deletion callbacks} testdcall { lsort -increasing [testdcall 1 2 3] } {1 2 3} test dcall-1.2 {deletion callbacks} testdcall { |
︙ | ︙ |
Changes to tests/dict.test.
1 2 3 4 5 6 7 | # This test file covers the dictionary object type and the dict command used # to work with values of that type. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # This test file covers the dictionary object type and the dict command used # to work with values of that type. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 2003-2009 Donal K. Fellows # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } |
︙ | ︙ |
Changes to tests/dstring.test.
1 2 3 4 5 6 | # Commands covered: none # # This file contains a collection of tests for Tcl's dynamic string library # procedures. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: none # # This file contains a collection of tests for Tcl's dynamic string library # procedures. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testdstring [llength [info commands testdstring]] if {[testConstraint testdstring]} { testdstring free } test dstring-1.1 {appending and retrieving} -constraints testdstring -setup { |
︙ | ︙ |
Changes to tests/encoding.test.
1 2 3 4 | # This file contains a collection of tests for tclEncoding.c # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # This file contains a collection of tests for tclEncoding.c # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } namespace eval ::tcl::test::encoding { variable x catch { ::tcltest::loadTestedCommands package require -exact tcl::test [info patchlevel] } proc toutf {args} { variable x lappend x "toutf $args" } proc fromutf {args} { |
︙ | ︙ | |||
60 61 62 63 64 65 66 | testencoding create foo [namespace origin toutf] [namespace origin fromutf] set x {} encoding convertto foo abcd testencoding delete foo return $x } {{fromutf }} test encoding-1.3 {Tcl_GetEncoding: load encoding} { | | | | | | | | 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 | testencoding create foo [namespace origin toutf] [namespace origin fromutf] set x {} encoding convertto foo abcd testencoding delete foo return $x } {{fromutf }} test encoding-1.3 {Tcl_GetEncoding: load encoding} { list [encoding convertto jis0208 乎] \ [encoding convertfrom jis0208 8C] } "8C 乎" test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} { encoding convertto jis0208 乎 } {8C} test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup { set system [encoding system] set path [encoding dirs] } -constraints {testencoding} -body { encoding system shiftjis ;# incr ref count encoding dirs [list [pwd]] set x [encoding convertto shiftjis 乎] ;# old one found encoding system iso8859-1 llength shiftjis ;# Shimmer away any cache of Tcl_Encoding lappend x [catch {encoding convertto shiftjis 乎} msg] $msg } -cleanup { encoding system iso8859-1 encoding dirs $path encoding system $system } -result "\x8C\xC1 1 {unknown encoding \"shiftjis\"}" test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup { set old [encoding system] } -body { encoding system shiftjis encoding system } -cleanup { |
︙ | ︙ | |||
133 134 135 136 137 138 139 | removeDirectory tmp } -result {junk junk2} test encoding-5.1 {Tcl_SetSystemEncoding} -setup { set old [encoding system] } -body { encoding system jis0208 | | | 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | removeDirectory tmp } -result {junk junk2} test encoding-5.1 {Tcl_SetSystemEncoding} -setup { set old [encoding system] } -body { encoding system jis0208 encoding convertto 乎 } -cleanup { encoding system iso8859-1 encoding system $old } -result {8C} test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} { set old [encoding system] encoding system $old |
︙ | ︙ | |||
165 166 167 168 169 170 171 | encoding convertto foo abcd testencoding delete foo return $x } {{toutf a} {fromutf b}} test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} { encoding convertfrom jis0208 8c8c8c8c | | | | | | | | | | | | | | | | | | | | | | | > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 | encoding convertto foo abcd testencoding delete foo return $x } {{toutf a} {fromutf b}} test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} { encoding convertfrom jis0208 8c8c8c8c } "吾吾吾吾" test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} { set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C append a $a append a $a append a $a append a $a 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 } "ab乎g" test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} { encoding convertto jis0208 "吾吾吾吾" } {8c8c8c8c} test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} { set a 乎乎乎乎乎乎乎乎 append a $a append a $a append a $a append a $a append a $a append a $a set x [encoding convertto jis0208 $a] list [string length $x] [string range $x 0 1] } "1024 8C" test encoding-10.1 {Tcl_UtfToExternal} { set f [open [file join [temporaryDirectory] dummy] w] fconfigure $f -translation binary -encoding shiftjis puts -nonewline $f "ab乎g" 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] set path [encoding dirs] encoding system iso8859-1 encoding dirs {} llength jis0208 ;# Shimmer any cached Tcl_Encoding in shared literal set x [list [catch {encoding convertto jis0208 乎} msg] $msg] encoding dirs $path encoding system $system lappend x [encoding convertto jis0208 乎] } {1 {unknown encoding "jis0208"} 8C} test encoding-11.2 {LoadEncodingFile: single-byte} { encoding convertfrom jis0201 \xA1 } "。" test encoding-11.3 {LoadEncodingFile: double-byte} { encoding convertfrom jis0208 8C } 乎 test encoding-11.4 {LoadEncodingFile: multi-byte} { encoding convertfrom shiftjis \x8C\xC1 } 乎 test encoding-11.5 {LoadEncodingFile: escape file} { 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] makeDirectory tmp makeDirectory [file join tmp encoding] set f [open [file join tmp encoding splat.enc] w] fconfigure $f -translation binary puts $f "abcdefghijklmnop" close $f encoding convertto splat 乎 } -returnCodes error -cleanup { file delete [file join [temporaryDirectory] tmp encoding splat.enc] removeDirectory [file join tmp encoding] 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)} # 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]] binary scan [teststringbytes $y] H* z set z } c080 test encoding-15.4 {UtfToUtfProc emoji character input} -body { set x \xED\xA0\xBD\xED\xB8\x82 set y [encoding convertfrom utf-8 \xED\xA0\xBD\xED\xB8\x82] list [string length $x] $y } -result "6 😂" test encoding-15.5 {UtfToUtfProc emoji character input} { set x \xF0\x9F\x98\x82 set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82] list [string length $x] $y } "4 😂" test encoding-15.6 {UtfToUtfProc emoji character output} { set x \uDE02\uD83D\uDE02\uD83D set y [encoding convertto utf-8 \uDE02\uD83D\uDE02\uD83D] binary scan $y H* z list [string length $y] $z } {10 edb882f09f9882eda0bd} 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 |
︙ | ︙ | |||
395 396 397 398 399 400 401 | } {1 3 eda882} test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} { set x \xF0\xA0\xA1\xC2 set y [encoding convertfrom utf-8 \xF0\xA0\xA1\xC2] list [string length $x] $y } "4 \xF0\xA0\xA1\xC2" test encoding-15.17 {UtfToUtfProc emoji character output} { | | | | | | 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 | } {1 3 eda882} test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} { set x \xF0\xA0\xA1\xC2 set y [encoding convertfrom utf-8 \xF0\xA0\xA1\xC2] list [string length $x] $y } "4 \xF0\xA0\xA1\xC2" test encoding-15.17 {UtfToUtfProc emoji character output} { set x 😂 set y [encoding convertto utf-8 😂] binary scan $y H* z list [string length $y] $z } {4 f09f9882} test encoding-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.4 {Ucs2ToUtfProc} -body { set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"] list $val [format %x [scan $val %c]] } -result "\U460DC 460dc" test encoding-17.1 {UtfToUtf16Proc} -body { encoding convertto utf-16 "\U460DC" |
︙ | ︙ | |||
450 451 452 453 454 455 456 | test encoding-21.1 {EscapeToUtfProc} { } {} test encoding-22.1 {EscapeFromUtfProc} { } {} | | | | | | | < < > > | < > | 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 | 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 |
︙ | ︙ | |||
526 527 528 529 530 531 532 | } } {} test encoding-24.2 {EscapeFreeProc on open channels} {exec} { # Bug #524674 output viewable [runInSubprocess { encoding system cp1252; # Bug #2891556 crash revelator fconfigure stdout -encoding iso2022-jp | | | | | | | | | | | | | | 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 | } } {} test encoding-24.2 {EscapeFreeProc on open channels} {exec} { # Bug #524674 output 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 test encoding-24.6 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xC1\xBF"] } 2 test encoding-24.7 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xC2\x80"] } 1 test encoding-24.8 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xE0\x80\x80"] } 3 test encoding-24.9 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xE0\x9F\xBF"] } 3 test encoding-24.10 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xE0\xA0\x80"] } 1 test encoding-24.11 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xEF\xBF\xBF"] } 1 file delete [file join [temporaryDirectory] iso2022.txt] # # Begin jajp encoding round-trip conformity tests # |
︙ | ︙ | |||
623 624 625 626 627 628 629 | } else { error "really?" } } } proc gen-jisx0208-euc-jp {code} { binary format cc \ | | | | | | | 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 | } 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} { |
︙ | ︙ |
Changes to tests/env.test.
1 2 3 4 5 6 | # Commands covered: none (tests environment variable implementation) # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: none (tests environment variable implementation) # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] package require tcltests # [exec] is required here to see the actual environment received by child # processes. proc getenv {} { global printenvScript catch {exec [interpreter] $printenvScript} out |
︙ | ︙ | |||
98 99 100 101 102 103 104 | encodingrestore envrestore } variable keep { TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH | | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | encodingrestore envrestore } 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 } variable printenvScript [makeFile [string map [list @keep@ [list $keep]] { |
︙ | ︙ |
Changes to tests/error.test.
1 2 3 4 5 6 | # Commands covered: error, catch, throw, try # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: error, catch, throw, try # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/eval.test.
1 2 3 4 5 6 | # Commands covered: eval # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: eval # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/event.test.
1 2 3 4 5 | # This file contains a collection of tests for the procedures in the file # tclEvent.c, which includes the "update", and "vwait" Tcl commands. Sourcing # this file into Tcl runs the tests and generates output for errors. No # output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # This file contains a collection of tests for the procedures in the file # tclEvent.c, which includes the "update", and "vwait" Tcl commands. Sourcing # this file into Tcl runs the tests and generates output for errors. No # output means no errors were found. # # Copyright © 1995-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.5 namespace import -force ::tcltest::* catch { ::tcltest::loadTestedCommands package require -exact tcl::test [info patchlevel] set ::tcltestlib [info loaded {} Tcltest] } testConstraint testfilehandler [llength [info commands testfilehandler]] testConstraint testexithandler [llength [info commands testexithandler]] testConstraint testfilewait [llength [info commands testfilewait]] testConstraint exec [llength [info commands exec]] |
︙ | ︙ |
Changes to tests/exec.test.
1 2 3 4 5 6 | # Commands covered: exec # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | # Commands covered: exec # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1994 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # There is no point in running Valgrind on cases where [exec] forks but then # fails and the child process doesn't go through full cleanup. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] package require tcltests # All tests require the "exec" command. # Skip them if exec is not defined. testConstraint exec [llength [info commands exec]] # Some skips when running in a macOS CI environment testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}] unset -nocomplain path # Utilities that are like bourne shell stalwarts, but cross-platform. set path(echo) [makeFile { puts -nonewline [lindex $argv 0] foreach str [lrange $argv 1 end] { |
︙ | ︙ | |||
108 109 110 111 112 113 114 | continue } lappend newcmd $arg } exit } sh2] set path(sleep) [makeFile { | | | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | continue } lappend newcmd $arg } exit } sh2] set path(sleep) [makeFile { after [expr {$argv*1000}] exit } sleep] set path(exit) [makeFile { exit $argv } exit] proc readfile filename { |
︙ | ︙ | |||
164 165 166 167 168 169 170 | 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} { |
︙ | ︙ | |||
669 670 671 672 673 674 675 | } -constraints {exec tempNotWin} -cleanup { removeFile $path(fooblah) } -result contents # Note that this test cannot be adapted to work on Windows; that platform has # no kernel support for an analog of O_APPEND. OTOH, that means we can assume # that there is a POSIX shell... | > > | | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 | } -constraints {exec tempNotWin} -cleanup { removeFile $path(fooblah) } -result contents # Note that this test cannot be adapted to work on Windows; that platform has # no kernel support for an analog of O_APPEND. OTOH, that means we can assume # that there is a POSIX shell... # # This test also fails in some cases when building with macOS test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosxCI} -setup { set tmpfile [makeFile {0} tmpfile.exec-19.1] } -body { # Note that we have to allow for the current contents of the temporary # file, which is why the result is 14 and not 12 exec /bin/sh -c \ {for a in 1 2 3; do sleep 1; echo $a; done} >>$tmpfile & exec /bin/sh -c \ |
︙ | ︙ |
Changes to tests/execute.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains tests for the tclExecute.c source file. Tests appear in # the same order as the C code that they test. The set of tests is currently # incomplete since it currently includes only new tests for code changed for # the addition of Tcl namespaces. Other execution-related tests appear in # several other test files including namespace.test, basic.test, eval.test, # for.test, etc. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # This file contains tests for the tclExecute.c source file. Tests appear in # the same order as the C code that they test. The set of tests is currently # incomplete since it currently includes only new tests for code changed for # the addition of Tcl namespaces. Other execution-related tests appear in # several other test files including namespace.test, basic.test, eval.test, # for.test, etc. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} catch {unset x} catch {unset y} catch {unset msg} |
︙ | ︙ | |||
813 814 815 816 817 818 819 | test execute-7.9 {Wide int handling in INST_MOD} { expr {(wide(1)<<60) % ((wide(47)<<45)-1)} } 316659348800185 test execute-7.10 {Wide int handling in INST_MOD} { expr {((wide(1)<<60)-1) % 0x400000000} } 17179869183 test execute-7.11 {Wide int handling in INST_LSHIFT} { | | | | | | | | | | | | | | | | | 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 | test execute-7.9 {Wide int handling in INST_MOD} { expr {(wide(1)<<60) % ((wide(47)<<45)-1)} } 316659348800185 test execute-7.10 {Wide int handling in INST_MOD} { expr {((wide(1)<<60)-1) % 0x400000000} } 17179869183 test execute-7.11 {Wide int handling in INST_LSHIFT} { expr {wide(42) << 30} } 45097156608 test execute-7.12 {Wide int handling in INST_LSHIFT} { expr {12345678901 << 3} } 98765431208 test execute-7.13 {Wide int handling in INST_RSHIFT} { expr {0x543210febcda9876 >> 7} } 47397893236700464 test execute-7.14 {Wide int handling in INST_RSHIFT} { expr {wide(0x9876543210febcda) >> 7} } -58286587177206407 test execute-7.15 {Wide int handling in INST_BITOR} { expr {wide(0x9876543210febcda) | 0x543210febcda9876} } -2560765885044310786 test execute-7.16 {Wide int handling in INST_BITXOR} { expr {wide(0x9876543210febcda) ^ 0x543210febcda9876} } -3727778945703861076 test execute-7.17 {Wide int handling in INST_BITAND} { expr {wide(0x9876543210febcda) & 0x543210febcda9876} } 1167013060659550290 test execute-7.18 {Wide int handling in INST_ADD} { expr {wide(0x7fffffff) + wide(0x7fffffff)} } 4294967294 test execute-7.19 {Wide int handling in INST_ADD} { expr {0x7fffffff + wide(0x7fffffff)} } 4294967294 test execute-7.20 {Wide int handling in INST_ADD} { expr {wide(0x7fffffff) + 0x7fffffff} } 4294967294 test execute-7.21 {Wide int handling in INST_ADD} { expr {double(0x7fffffff) + wide(0x7fffffff)} } 4294967294.0 test execute-7.22 {Wide int handling in INST_ADD} { expr {wide(0x7fffffff) + double(0x7fffffff)} } 4294967294.0 test execute-7.23 {Wide int handling in INST_SUB} { expr {0x123456789a - 0x20406080a} } 69530054800 test execute-7.24 {Wide int handling in INST_MULT} { expr {0x123456789a * 193} } 15090186251290 test execute-7.25 {Wide int handling in INST_DIV} { expr {0x123456789a / 193} } 405116546 test execute-7.26 {Wide int handling in INST_UPLUS} { set x 0x123456871234568 expr {+ $x} } 81985533099853160 test execute-7.27 {Wide int handling in INST_UMINUS} { set x 0x123456871234568 |
︙ | ︙ | |||
977 978 979 980 981 982 983 | invoked from within "catch \[list error FOO\] m o"} -errorline 2} test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup { interp create child child eval { package require tcltest 2.5 | | | 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 | invoked from within "catch \[list error FOO\] m o"} -errorline 2} test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup { interp create child child eval { package require tcltest 2.5 catch [list package require -exact tcl::test [info patchlevel]] ::tcltest::loadTestedCommands if {[namespace which -command testbumpinterpepoch] eq ""} { proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } } } } -body { child eval { |
︙ | ︙ | |||
1010 1011 1012 1013 1014 1015 1016 | } -cleanup { interp delete child } -result [lrepeat 4 A B] test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup { interp create child child eval { package require tcltest 2.5 | | | 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 | } -cleanup { interp delete child } -result [lrepeat 4 A B] test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup { interp create child child eval { package require tcltest 2.5 catch [list package require -exact tcl::test [info patchlevel]] ::tcltest::loadTestedCommands if {[namespace which -command testbumpinterpepoch] eq ""} { proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } } } } -body { set res {} |
︙ | ︙ | |||
1058 1059 1060 1061 1062 1063 1064 | } else { set result SUCCESS } set result } SUCCESS test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} { | | | 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 | } 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.
1 2 3 4 5 6 7 8 | # Commands covered: expr # # This file contains the original set of tests for Tcl's expr command. # Since the expr command is now compiled, a new set of tests covering # the new implementation are in the files "parseExpr.test" and # "compExpr.test". Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # | | | | | | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 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 | # Commands covered: expr # # This file contains the original set of tests for Tcl's expr command. # Since the expr command is now compiled, a new set of tests covering # the new implementation are in the files "parseExpr.test" and # "compExpr.test". Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright © 1991-1994 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-2000 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testexprlong [llength [info commands testexprlong]] testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] # 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 } |
︙ | ︙ | |||
520 521 522 523 524 525 526 | test expr-old-26.10a {error conditions} !ieeeFloatingPoint { list [catch {expr 2.0/0.0} msg] $msg $errorCode } {1 {divide by zero} {ARITH DIVZERO {divide by zero}}} test expr-old-26.10b {error conditions} ieeeFloatingPoint { list [catch {expr 2.0/0.0} msg] $msg } {0 Inf} test expr-old-26.11 {error conditions} -body { | | | 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 | test expr-old-26.10a {error conditions} !ieeeFloatingPoint { list [catch {expr 2.0/0.0} msg] $msg $errorCode } {1 {divide by zero} {ARITH DIVZERO {divide by zero}}} test expr-old-26.10b {error conditions} ieeeFloatingPoint { list [catch {expr 2.0/0.0} msg] $msg } {0 Inf} test expr-old-26.11 {error conditions} -body { expr 2` } -returnCodes error -match glob -result * test expr-old-26.12 {error conditions} -body { expr a.b } -returnCodes error -match glob -result * test expr-old-26.13 {error conditions} { list [catch {expr {"a"/"b"}} msg] $msg } {1 {can't use non-numeric string "a" as operand of "/"}} |
︙ | ︙ |
Changes to tests/expr.test.
1 2 3 4 5 6 | # Commands covered: expr # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # Commands covered: expr # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1996-1997 Sun Microsystems, Inc. # Copyright © 1998-2000 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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 | 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 } |
︙ | ︙ | |||
346 347 348 349 350 351 352 | 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 | | | 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 | 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 { |
︙ | ︙ | |||
6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 | } { 0x0} test expr-38.12 {abs and -0x0 [Bug 2954959]} { ::tcl::mathfunc::abs { -0x0} } 0 test expr-38.13 {abs and 0.0 [Bug 2954959]} { ::tcl::mathfunc::abs 1e-324 } 1e-324 testConstraint testexprlongobj [llength [info commands testexprlongobj]] testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]] test expr-39.1 {Check that Tcl_ExprLongObj doesn't modify interpreter result if no error} testexprlongobj { testexprlongobj 4+1 } {This is a result: 5} | > > > > > > | 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 | } { 0x0} test expr-38.12 {abs and -0x0 [Bug 2954959]} { ::tcl::mathfunc::abs { -0x0} } 0 test expr-38.13 {abs and 0.0 [Bug 2954959]} { ::tcl::mathfunc::abs 1e-324 } 1e-324 test expr-38.14 {abs and INT64_MIN special-case} { ::tcl::mathfunc::abs -9223372036854775808 } 9223372036854775808 test expr-38.15 {abs and INT128_MIN special-case} { ::tcl::mathfunc::abs -170141183460469231731687303715884105728 } 170141183460469231731687303715884105728 testConstraint testexprlongobj [llength [info commands testexprlongobj]] testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]] test expr-39.1 {Check that Tcl_ExprLongObj doesn't modify interpreter result if no error} testexprlongobj { testexprlongobj 4+1 } {This is a result: 5} |
︙ | ︙ | |||
7379 7380 7381 7382 7383 7384 7385 7386 7387 7388 7389 7390 7391 7392 7393 7394 7395 7396 | foreach v2 $values r2 $results { test expr-61.[incr ctr] "float classification: isunordered($v1,$v2)" { expr {isunordered($v1, $v2)} } [expr {$r1 || $r2}] } } unset -nocomplain values results ctr # cleanup unset -nocomplain a unset -nocomplain min unset -nocomplain max ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 7385 7386 7387 7388 7389 7390 7391 7392 7393 7394 7395 7396 7397 7398 7399 7400 7401 7402 7403 7404 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421 7422 7423 7424 7425 7426 7427 7428 7429 7430 7431 7432 7433 7434 7435 7436 7437 7438 7439 7440 7441 7442 7443 7444 7445 7446 7447 7448 7449 7450 7451 7452 7453 7454 7455 7456 7457 7458 7459 7460 7461 7462 7463 | foreach v2 $values r2 $results { test expr-61.[incr ctr] "float classification: isunordered($v1,$v2)" { expr {isunordered($v1, $v2)} } [expr {$r1 || $r2}] } } unset -nocomplain values results ctr test expr-62.1 {TIP 582: comments} -body { expr {1 # + 2} } -result 1 test expr-62.2 {TIP 582: comments} -body { expr "1 #\n+ 2" } -result 3 test expr-62.3 {TIP 582: comments} -setup { set ctr 0 } -body { expr { # This is a demonstration of a comment 1 + 2 + 3 # and another comment + 4 + 5 # + [incr ctr] + [incr ctr] } } -result 16 # Buggy because line breaks aren't tracked inside expressions at all test expr-62.4 {TIP 582: comments don't hide line breaks} -setup { proc getline {} { dict get [info frame -1] line } set base [getline] } -constraints knownBug -body { expr { 0 # a comment + [getline] - $base } } -cleanup { rename getline "" } -result 5 test expr-62.5 {TIP 582: comments don't splice tokens} { set a False expr {$a#don't splice ne#don't splice false} } 1 test expr-62.6 {TIP 582: comments don't splice tokens} { expr {0x2#don't splice ne#don't splice 2} } 1 test expr-62.7 {TIP 582: comments can go inside function calls} { expr {max(1,# comment 2)} } 2 test expr-62.8 {TIP 582: comments can go inside function calls} { expr {max(1# comment ,2)} } 2 test expr-62.9 {TIP 582: comments can go inside function calls} { expr {max(# comment 1,2)} } 2 test expr-62.10 {TIP 582: comments can go inside function calls} { expr {max# comment (1,2)} } 2 # cleanup unset -nocomplain a unset -nocomplain min unset -nocomplain max ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/fCmd.test.
1 2 3 4 5 6 | # This file tests the tclFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | < | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # This file tests the tclFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1996-1997 Sun Microsystems, Inc. # Copyright © 1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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]] cd [temporaryDirectory] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testchmod [llength [info commands testchmod]] testConstraint winLessThan10 0 # Don't know how to determine this constraint correctly testConstraint notNetworkFilesystem 0 testConstraint reg 0 if {[testConstraint win]} { catch { # Is the registry extension already static to this shell? try { load {} Registry set ::reglib {} } on error {} { # try the location given to use on the commandline to tcltest ::tcltest::loadTestedCommands load $::reglib Registry } testConstraint reg 1 } } testConstraint notInCIenv [expr {![info exists ::env(CI)] || !$::env(CI)}] set tmpspace /tmp;# default value # Find a group that exists on this Unix system, or else skip tests that # require Unix groups. testConstraint foundGroup [expr {![testConstraint unix]}] if {[testConstraint unix]} { catch { |
︙ | ︙ | |||
61 62 63 64 65 66 67 | if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { testConstraint xdev [expr {([dev .] != [dev $tmpspace])}] } } # Also used in winFCmd... | | < | < < < > | 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 | if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { testConstraint xdev [expr {([dev .] != [dev $tmpspace])}] } } # Also used in winFCmd... if {[testConstraint win] && $::tcl_platform(osVersion) < 10.0} { testConstraint winLessThan10 1 } testConstraint darwin9 [expr { [testConstraint unix] && $tcl_platform(os) eq "Darwin" && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9] }] testConstraint notDarwin9 [expr {![testConstraint darwin9]}] testConstraint notContinuousIntegration [expr {![info exists ::env(CI)]}] testConstraint fileSharing 0 testConstraint notFileSharing 1 testConstraint linkFile 1 testConstraint linkDirectory 1 # Several tests require need to match results against the unix username |
︙ | ︙ | |||
271 272 273 274 275 276 277 | } -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 |
︙ | ︙ | |||
313 314 315 316 317 318 319 | 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 { |
︙ | ︙ | |||
618 619 620 621 622 623 624 | file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf*] } -result [file join $tmpspace tf1] test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace } -constraints {xdev notRoot} -body { file mkdir td1/td2/td3 | | | | | | | | | | | | 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 | file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf*] } -result [file join $tmpspace tf1] test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace } -constraints {xdev notRoot} -body { file mkdir td1/td2/td3 file attributes td1 -permissions 0 file rename td1 $tmpspace } -returnCodes error -cleanup { file attributes td1 -permissions 0o755 cleanup } -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$} test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir ~/td1/td2 set td1name [file join [file dirname ~] [file tail ~] td1] file attributes $td1name -permissions 0 file copy ~/td1 td1 } -returnCodes error -cleanup { file attributes $td1name -permissions 0o755 file delete -force ~/td1 } -result {error copying "~/td1": permission denied} test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td2 file mkdir ~/td1 set td1name [file join [file dirname ~] [file tail ~] td1] file attributes $td1name -permissions 0 file copy td2 ~/td1 } -returnCodes error -cleanup { file attributes $td1name -permissions 0o755 file delete -force ~/td1 } -result {error copying "td2" to "~/td1/td2": permission denied} test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir ~/td1/td2 set td2name [file join [file dirname ~] [file tail ~] td1 td2] file attributes $td2name -permissions 0 file copy ~/td1 td1 } -returnCodes error -cleanup { file attributes $td2name -permissions 0o755 file delete -force ~/td1 } -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace } -constraints {notRoot xdev} -returnCodes error -body { file mkdir td1/td2/td3 file mkdir [file join $tmpspace td1] createfile [file join $tmpspace td1 tf1] file rename -force td1 $tmpspace } -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists} test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace } -constraints {notRoot xdev} -body { file mkdir td1/td2/td3 file attributes td1/td2/td3 -permissions 0 file rename td1 $tmpspace } -returnCodes error -cleanup { file attributes td1/td2/td3 -permissions 0o755 cleanup $tmpspace } -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied} test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup { cleanup $tmpspace } -constraints {notRoot xdev} -body { file mkdir td1/td2/td3 file rename td1 $tmpspace |
︙ | ︙ | |||
784 785 786 787 788 789 790 | createfile tf1 createfile tf2 testchmod 0o444 tf2 file rename tf1 tf3 file rename tf2 tf4 list [lsort [glob tf*]] [file writable tf3] [file writable tf4] } -result {{tf3 tf4} 1 0} | | < < < < < < < < < < < | < < < < < < < < < < | 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 | createfile tf1 createfile tf2 testchmod 0o444 tf2 file rename tf1 tf3 file rename tf2 tf4 list [lsort [glob tf*]] [file writable tf3] [file writable tf4] } -result {{tf3 tf4} 1 0} test fCmd-9.4 {file rename: comprehensive: dir to new name} -setup { cleanup } -constraints {unix notRoot testchmod notDarwin9} -body { file mkdir td1 td2 testchmod 0o555 td2 file rename td1 td3 file rename td2 td4 list [lsort [glob td*]] [file writable td3] [file writable td4] } -cleanup { cleanup } -result {{td3 td4} 1 0} test fCmd-9.5 {file rename: comprehensive: file to self} -setup { cleanup } -constraints {notRoot testchmod notWine} -body { createfile tf1 tf1 createfile tf2 tf2 testchmod 0o444 tf2 file rename -force tf1 tf1 file rename -force tf2 tf2 list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2] } -result {tf1 tf2 1 0} test fCmd-9.6 {file rename: comprehensive: dir to self} -setup { cleanup } -constraints {unix notRoot testchmod} -body { file mkdir td1 file mkdir td2 testchmod 0o555 td2 file rename -force td1 . file rename -force td2 . |
︙ | ︙ | |||
904 905 906 907 908 909 910 | test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup { cleanup } -constraints {notRoot testchmod notWine} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] | < < < < | < < < | 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 | test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup { cleanup } -constraints {notRoot testchmod notWine} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg] set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg] set w2 0 list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2 } -match glob -result \ [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file *}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file *}} 1 0}] test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { createfile tf1 |
︙ | ︙ | |||
935 936 937 938 939 940 941 | } -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { file mkdir td1 file mkdir td2 file mkdir td3 | < < < < | < < < | 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 | } -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { file mkdir td1 file mkdir td2 file mkdir td3 file rename td1 [file join td3 td3] file rename td2 [file join td3 td4] set w4 0 list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] $w4 } -result [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] test fCmd-9.12 {file rename: comprehensive: target exists} -setup { cleanup } -constraints {notRoot testchmod notNetworkFilesystem} -body { file mkdir [file join td1 td2] [file join td2 td1] |
︙ | ︙ | |||
1337 1338 1339 1340 1341 1342 1343 | file delete -force tfad } -result {1} test fCmd-12.8 {renamefile: generic error} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/dir | | | | 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 | file delete -force tfad } -result {1} test fCmd-12.8 {renamefile: generic error} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/dir file attributes tfa -permissions 0o555 catch {file rename tfa/dir tfa2} } -cleanup { catch {file attributes tfa -permissions 0o777} file delete -force tfa } -result {1} test fCmd-12.9 {renamefile: moving a file across volumes} -setup { cleanup $tmpspace } -constraints {unix notRoot} -body { set s [createfile tfa] file rename tfa $tmpspace |
︙ | ︙ | |||
1523 1524 1525 1526 1527 1528 1529 | } -cleanup { file delete -force tfa tfa2 } -result {1 1} test fCmd-14.8 {copyfile: copy directory failing} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa/dir/a/b/c | | | | 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 | } -cleanup { file delete -force tfa tfa2 } -result {1 1} test fCmd-14.8 {copyfile: copy directory failing} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa/dir/a/b/c file attributes tfa/dir -permissions 0 catch {file copy tfa tfa2} } -cleanup { file attributes tfa/dir -permissions 0o777 file delete -force tfa tfa2 } -result {1} # # Coverage tests for TclMkdirCmd() # test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup { |
︙ | ︙ | |||
1566 1567 1568 1569 1570 1571 1572 | file delete tfa1 tfa2 } -result {1 1} test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa createfile tfa/file | | | | 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 | file delete tfa1 tfa2 } -result {1 1} test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa createfile tfa/file file attributes tfa -permissions 0 catch {file mkdir tfa/file} } -cleanup { file attributes tfa -permissions 0o777 file delete -force tfa } -result {1} test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { file mkdir tfa/a/b/c file isdir tfa/a/b/c |
︙ | ︙ | |||
1666 1667 1668 1669 1670 1671 1672 | file delete -force tfa } -result {1} test fCmd-16.9 {error while deleting file} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa createfile tfa/a | | | | 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 | file delete -force tfa } -result {1} test fCmd-16.9 {error while deleting file} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa createfile tfa/a file attributes tfa -permissions 0o555 catch {file delete tfa/a} ####### ####### If any directory in a tree that is being removed does not have ####### write permission, the process will fail! This is also the case ####### with "rm -rf" ####### } -cleanup { file attributes tfa -permissions 0o777 file delete -force tfa } -result {1} test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup { catch {file delete -force -- tfa1 tfa2} } -body { createfile tfa1 createfile tfa2 |
︙ | ︙ | |||
1696 1697 1698 1699 1700 1701 1702 | } -result {} # More coverage tests for mkpath() test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup { catch {file delete -force -- tfa1} } -constraints {unix notRoot} -body { file mkdir tfa1 | | | | 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 | } -result {} # More coverage tests for mkpath() test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup { catch {file delete -force -- tfa1} } -constraints {unix notRoot} -body { file mkdir tfa1 file attributes tfa1 -permissions 0o555 catch {file mkdir tfa1/tfa2} } -cleanup { file attributes tfa1 -permissions 0o777 file delete -force tfa1 } -result {1} test fCmd-17.2 {mkdir several levels deep - relative} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { file mkdir tfa/a/b file isdir tfa/a/b |
︙ | ︙ | |||
1907 1908 1909 1910 1911 1912 1913 | file exists tfa } -result {0} test fCmd-19.2 {rmdir error besides EEXIST} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/a | | | | 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 | file exists tfa } -result {0} test fCmd-19.2 {rmdir error besides EEXIST} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/a file attributes tfa -permissions 0o555 catch {file delete tfa/a} } -cleanup { file attributes tfa -permissions 0o777 file delete -force tfa } -result {1} test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { file mkdir tfa file mkdir tfa/a |
︙ | ︙ | |||
1935 1936 1937 1938 1939 1940 1941 | # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd # test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/a | | | | 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 | # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd # test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/a file attributes tfa/a -permissions 00000 catch {file delete -force tfa} } -cleanup { file attributes tfa/a -permissions 0o777 file delete -force tfa } -result {1} test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { file mkdir tfa for {set i 1} {$i <= 300} {incr i} { |
︙ | ︙ | |||
2349 2350 2351 2352 2353 2354 2355 | test fCmd-28.7 {file link: source already exists} -setup { cd [temporaryDirectory] } -constraints {linkFile} -body { file link abc.file abc2.file } -returnCodes error -cleanup { cd [workingDirectory] } -result {could not create new link "abc.file": that path already exists} | > | | > | | 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 | test fCmd-28.7 {file link: source already exists} -setup { cd [temporaryDirectory] } -constraints {linkFile} -body { file link abc.file abc2.file } -returnCodes error -cleanup { cd [workingDirectory] } -result {could not create new link "abc.file": that path already exists} # In Windows 10 developer mode, we _can_ create symbolic links to files! test fCmd-28.8 {file link} -constraints {linkFile winLessThan10} -setup { cd [temporaryDirectory] } -body { file link -symbolic abc.link abc.file } -cleanup { file delete -force abc.link cd [workingDirectory] } -returnCodes error -result {could not create new link "abc.link" pointing to "abc.file": invalid argument} test fCmd-28.9 {file link: success with file} -constraints {linkFile} -setup { cd [temporaryDirectory] file delete -force abc.link } -body { file link abc.link abc.file } -cleanup { cd [workingDirectory] |
︙ | ︙ | |||
2577 2578 2579 2580 2581 2582 2583 | file writable $mydocsname } -result 1 test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body { expr {[info exists env(USERPROFILE)] && [file exists $env(USERPROFILE)/NTUSER.DAT] && [file readable $env(USERPROFILE)/NTUSER.DAT]} } -result {1} | > > | | 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 | file writable $mydocsname } -result 1 test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body { expr {[info exists env(USERPROFILE)] && [file exists $env(USERPROFILE)/NTUSER.DAT] && [file readable $env(USERPROFILE)/NTUSER.DAT]} } -result {1} # At least one CI environment (GitHub Actions) is set up with the page file in # an unusual location; skip the test if that is so. test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notInCIenv} -body { set r {} if {[info exists env(SystemDrive)]} { set path $env(SystemDrive)/pagefile.sys lappend r exists [file exists $path] lappend r readable [file readable $path] lappend r stat [catch {file stat $path a} e] $e } |
︙ | ︙ |
Changes to tests/fileName.test.
1 2 3 4 5 6 | # This file tests the filename manipulation routines. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # This file tests the filename manipulation routines. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1995-1996 Sun Microsystems, Inc. # Copyright © 1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testsetplatform [llength [info commands testsetplatform]] testConstraint testtranslatefilename [llength [info commands testtranslatefilename]] testConstraint linkDirectory 1 testConstraint symbolicLinkFile 1 if {[testConstraint win]} { if {$::tcl_platform(osVersion) < 5.0 \ || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} { testConstraint linkDirectory 0 } testConstraint symbolicLinkFile 0 testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}] } testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] # This match compares the first two words of the result. If the wanted result # is "equal", then this is successful if the words are equal. If the wanted # result is "not equal", then this is successful if the words are different. customMatch compareWords {apply {{a b} { lassign $b w1 w2 expr {$a eq "equal" ? $w1 eq $w2 : $w1 ne $w2} }}} |
︙ | ︙ | |||
1059 1060 1061 1062 1063 1064 1065 | } -result {"-directory" cannot be used with "-path"} test filename-11.45 {Tcl_GlobCmd on root volume} -setup { set res1 "" set res2 "" set tmpd [pwd] } -body { catch { | | | | 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 | } -result {"-directory" cannot be used with "-path"} test filename-11.45 {Tcl_GlobCmd on root volume} -setup { set res1 "" set res2 "" set tmpd [pwd] } -body { catch { set res1 [glob -dir [lindex [file volumes] end] -tails *] } catch { cd [lindex [file volumes] end] set res2 [glob *] } list $res1 $res2 } -cleanup { cd $tmpd } -match compareWords -result equal test filename-11.46 {Tcl_GlobCmd} -returnCodes error -body { |
︙ | ︙ | |||
1325 1326 1327 1328 1329 1330 1331 | unset globname # The following tests are only valid for Unix systems. On some systems, like # AFS, "000" protection doesn't prevent access by owner, so the following test # is not portable. | | | | 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 | unset globname # The following tests are only valid for Unix systems. On some systems, like # AFS, "000" protection doesn't prevent access by owner, so the following test # is not portable. catch {file attributes globTest/a1 -permissions 0} test filename-15.1 {unix specific globbing} {unix nonPortable} { string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode] } {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}} test filename-15.2 {unix specific no complain: no errors} {unix nonPortable} { glob -nocomplain globTest/a1/* } {} test filename-15.3 {unix specific no complain: no errors, good result} \ {unix nonPortable} { # test fails because if an error occurs, the interp's result is reset... glob -nocomplain globTest/a2 globTest/a1/* globTest/a3 } {globTest/a2 globTest/a3} catch {file attributes globTest/a1 -permissions 0o755} test filename-15.4 {unix specific no complain: no errors, good result} \ {unix nonPortable} { # test fails because if an error occurs, the interp's result is reset... # or you don't run at scriptics where the outser and welch users exists glob -nocomplain ~ouster ~foo ~welch } {/home/ouster /home/welch} test filename-15.4.1 {no complain: errors, sequencing} { |
︙ | ︙ |
Changes to tests/fileSystem.test.
1 2 3 4 5 6 | # This file tests the filesystem and vfs internals. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | | > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 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 | # This file tests the filesystem and vfs internals. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 2002 Vincent Darley. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. namespace eval ::tcl::test::fileSystem { if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } catch { file delete -force link.file file delete -force dir.link file delete -force [file join dir.dir linkinside.file] } testConstraint loaddll 0 catch { ::tcltest::loadTestedCommands package require -exact tcl::test [info patchlevel] set ::ddever [package require dde] set ::ddelib [info loaded {} Dde] set ::regver [package require registry] set ::reglib [info loaded {} Registry] testConstraint loaddll [expr {$::ddelib ne "" && $::reglib ne ""}] } # Test for commands defined in tcl::test package testConstraint testfilesystem [llength [info commands ::testfilesystem]] testConstraint testsetplatform [llength [info commands ::testsetplatform]] testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]] # 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)]}] cd [tcltest::temporaryDirectory] makeFile "test file" gorp.file makeDirectory dir.dir makeDirectory [file join dir.dir dirinside.dir] makeFile "test file in directory" [file join dir.dir inside.file] |
︙ | ︙ | |||
161 162 163 164 165 166 167 | test filesystem-1.12 {file new native path} {} { for {set i 0} {$i < 10} {incr i} { foreach f [lsort [glob -nocomplain -type l *]] { catch {file readlink $f} } } # If we reach here we've succeeded. We used to crash above. | | | 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 | test filesystem-1.12 {file new native path} {} { for {set i 0} {$i < 10} {incr i} { foreach f [lsort [glob -nocomplain -type l *]] { catch {file readlink $f} } } # If we reach here we've succeeded. We used to crash above. expr {1} } {1} test filesystem-1.13 {file normalisation} {win} { # This used to be broken file normalize C:/thislongnamedoesntexist } {C:/thislongnamedoesntexist} test filesystem-1.14 {file normalisation} {win} { # This used to be broken |
︙ | ︙ | |||
312 313 314 315 316 317 318 | } 1 test filesystem-1.37 {file normalisation with '/./'} -body { set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....." file norm $fname } -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$} test filesystem-1.38 {file normalisation with volume relative} -setup { set dir [pwd] | | | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 | } 1 test filesystem-1.37 {file normalisation with '/./'} -body { set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....." file norm $fname } -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$} test filesystem-1.38 {file normalisation with volume relative} -setup { set dir [pwd] } -constraints {win moreThanOneDrive notInCIenv} -body { set path "[string range [lindex $drives 0] 0 1]foo" cd [lindex $drives 1] file norm $path } -cleanup { cd $dir } -result "[lindex $drives 0]foo" test filesystem-1.39 {file normalisation with volume relative} -setup { |
︙ | ︙ | |||
561 562 563 564 565 566 567 | test filesystem-7.1.1 {load from vfs} -setup { set dir [pwd] } -constraints {win testsimplefilesystem loaddll} -body { # This may cause a crash on exit cd [file dirname $::ddelib] testsimplefilesystem 1 # This loads dde via a complex copy-to-temp operation | | | 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 | test filesystem-7.1.1 {load from vfs} -setup { set dir [pwd] } -constraints {win testsimplefilesystem loaddll} -body { # This may cause a crash on exit cd [file dirname $::ddelib] testsimplefilesystem 1 # This loads dde via a complex copy-to-temp operation load simplefs:/[file tail $::ddelib] Dde testsimplefilesystem 0 return ok # The real result of this test is what happens when Tcl exits. } -cleanup { cd $dir } -result ok test filesystem-7.1.2 {load from vfs, and then unload again} -setup { |
︙ | ︙ | |||
688 689 690 691 692 693 694 | puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 } -constraints {testsimplefilesystem unix} -body { # First copy should succeed set res [catch {file copy simplefs:/simplefile file2} err] lappend res $err | | | 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 | puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 } -constraints {testsimplefilesystem unix} -body { # First copy should succeed set res [catch {file copy simplefs:/simplefile file2} err] lappend res $err file attributes file2 -permissions 0 # Second copy should fail (no -force) lappend res [catch {file copy simplefs:/simplefile file2} err] lappend res $err # Third copy should succeed (-force) lappend res [catch {file copy -force simplefs:/simplefile file2} err] lappend res $err lappend res [file exists file2] |
︙ | ︙ |
Changes to tests/fileSystemEncoding.test.
1 2 | #! /usr/bin/env tclsh | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | #! /usr/bin/env tclsh # Copyright © 2019 Poor Yorick if {[string equal $::tcl_platform(os) "Windows NT"]} { return } 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/for-old.test.
1 2 3 4 5 6 7 8 | # Commands covered: for, continue, break # # This file contains the original set of tests for Tcl's for command. # Since the for command is now compiled, a new set of tests covering # the new implementation is in the file "for.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 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 | # Commands covered: for, continue, break # # This file contains the original set of tests for Tcl's for command. # Since the for command is now compiled, a new set of tests covering # the new implementation is in the file "for.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Check "for" and its use of continue and break. catch {unset a i} test for-old-1.1 {for tests} { set a {} for {set i 1} {$i<6} {incr i} { set a [concat $a $i] } set a } {1 2 3 4 5} test for-old-1.2 {for tests} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==4} continue set a [concat $a $i] } set a } {1 2 3 5} test for-old-1.3 {for tests} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==4} break set a [concat $a $i] } set a } {1 2 3} test for-old-1.4 {for tests} {catch {for 1 2 3} msg} 1 test for-old-1.5 {for tests} { catch {for 1 2 3} msg set msg } {wrong # args: should be "for start test next command"} test for-old-1.6 {for tests} {catch {for 1 2 3 4 5} msg} 1 test for-old-1.7 {for tests} { catch {for 1 2 3 4 5} msg set msg } {wrong # args: should be "for start test next command"} test for-old-1.8 {for tests} { set a {xyz} for {set i 1} {$i<6} {incr i} {} set a } xyz test for-old-1.9 {for tests} { set a {} for {set i 1} {$i<6} {incr i; if {$i==4} break} { set a [concat $a $i] } set a } {1 2 3} # cleanup ::tcltest::cleanupTests return |
Changes to tests/for.test.
1 2 3 4 5 6 | # Commands covered: for, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # Commands covered: for, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
58 59 60 61 62 63 64 | set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} catch {unset a} test for-1.9 {TclCompileForCmd: simple command body} { set a {} | | | | | | | | | 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 | set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} catch {unset a} test for-1.9 {TclCompileForCmd: simple command body} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==4} break set a [concat $a $i] } set a } {1 2 3} test for-1.10 {TclCompileForCmd: command body in quotes} { set a {} for {set i 1} {$i<6} {incr i} "append a x" set a } {xxxxx} test for-1.11 {TclCompileForCmd: computed command body} { catch {unset x1} catch {unset bb} catch {unset x2} set x1 {append a x1; } set bb {break} set x2 {; append a x2} set a {} for {set i 1} {$i<6} {incr i} $x1$bb$x2 set a } {x1} test for-1.12 {TclCompileForCmd: error in "next" command} -body { catch {for {set i 0} {$i < 5} {set} {format $i}} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test for-1.13 {TclCompileForCmd: long command body} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ | |||
125 126 127 128 129 130 131 | set a } {1 2 3} test for-1.14 {TclCompileForCmd: for command result} { set a [for {set i 0} {$i < 5} {incr i} {}] set a } {} test for-1.15 {TclCompileForCmd: for command result} { | | | | | | | | | 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 | set a } {1 2 3} test for-1.14 {TclCompileForCmd: for command result} { set a [for {set i 0} {$i < 5} {incr i} {}] set a } {} test for-1.15 {TclCompileForCmd: for command result} { set a [for {set i 0} {$i < 5} {incr i} {if {$i==3} break}] set a } {} # Check "for" and "continue". test for-2.1 {TclCompileContinueCmd: arguments after "continue"} { catch {continue foo} msg set msg } {wrong # args: should be "continue"} test for-2.2 {TclCompileContinueCmd: continue result} { catch continue } 4 test for-2.3 {continue tests} { set a {} for {set i 1} {$i <= 4} {incr i} { if {$i == 2} continue set a [concat $a $i] } set a } {1 3 4} test for-2.4 {continue tests} { set a {} for {set i 1} {$i <= 4} {incr i} { if {$i != 2} continue set a [concat $a $i] } set a } {2} test for-2.5 {continue tests, nested loops} { set msg {} for {set i 1} {$i <= 4} {incr i} { for {set a 1} {$a <= 2} {incr a} { if {$i>=2 && $a>=2} continue set msg [concat $msg "$i.$a"] } } set msg } {1.1 1.2 2.1 3.1 4.1} test for-2.6 {continue tests, long command body} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==2} continue if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ | |||
242 243 244 245 246 247 248 | set msg [concat $msg "$i.$a"] } } set msg } {1.1 1.2 2.1 3.1 4.1} test for-3.5 {break tests, long command body} { set a {} | | | | | | | 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 | set msg [concat $msg "$i.$a"] } } set msg } {1.1 1.2 2.1 3.1 4.1} test for-3.5 {break tests, long command body} { set a {} for {set i 1} {$i<6} {incr i} { if {$i==2} continue if {$i==5} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i==4} break if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ | |||
382 383 384 385 386 387 388 | if {[regexp {^[ ]*$} $line] || [regexp {^--+} $line]} { set inheaders 0 } if {[regexp -nocase {^x-mailer:} $line]} { continue } } | | | 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 | if {[regexp {^[ ]*$} $line] || [regexp {^--+} $line]} { set inheaders 0 } if {[regexp -nocase {^x-mailer:} $line]} { continue } } if {$inheaders} { set limit 55 } else { set limit 55 # Decide whether or not to break the body line if {$plen > 0} { if {[string first {> } $line] == 0} { # This is quoted text from previous message, don't reformat |
︙ | ︙ | |||
426 427 428 429 430 431 432 | append result $line $NL if {[string length $F1] == 0} { set F1 -1 } continue } } | | | | | 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 | append result $line $NL if {[string length $F1] == 0} { set F1 -1 } continue } } set climit [expr {$limit-1}] set cutoff 50 set continuation 0 while {[string length $line] > $limit} { for {set c [expr {$limit-1}]} {$c >= $cutoff} {incr c -1} { set char [string index $line $c] if {$char == " " || $char == "\t"} { break } if {$char == ">"} { ;# Hack for enriched formatting break } } if {$c < $cutoff} { if {! $inheaders} { set c [expr {$limit-1}] } else { set c [string length $line] } } set newline [string trimright [string range $line 0 $c]] if {! $continuation} { append result $newline $NL |
︙ | ︙ | |||
581 582 583 584 585 586 587 | } # Check that "break" resets the interpreter's result test for-4.1 {break must reset the interp result} { catch { set z GLOBTESTDIR/dir2/file2.c | | | 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 | } # Check that "break" resets the interpreter's result test for-4.1 {break must reset the interp result} { catch { set z GLOBTESTDIR/dir2/file2.c if {[string match GLOBTESTDIR/dir2/* $z]} { break } } j set j } {} # Test for incorrect "double evaluation" semantics |
︙ | ︙ | |||
692 693 694 695 696 697 698 | "set" ("for" body line 1) invoked from within "$z {set i 0} {$i < 5} {incr i} {set}"} test for-6.10 {Tcl_ForObjCmd: simple command body} { set z for set a {} | | | | | | | | | 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 | "set" ("for" body line 1) invoked from within "$z {set i 0} {$i < 5} {incr i} {set}"} test for-6.10 {Tcl_ForObjCmd: simple command body} { set z for set a {} $z {set i 1} {$i<6} {incr i} { if {$i==4} break set a [concat $a $i] } set a } {1 2 3} test for-6.11 {Tcl_ForObjCmd: command body in quotes} { set z for set a {} $z {set i 1} {$i<6} {incr i} "append a x" set a } {xxxxx} test for-6.12 {Tcl_ForObjCmd: computed command body} { set z for catch {unset x1} catch {unset bb} catch {unset x2} set x1 {append a x1; } set bb {break} set x2 {; append a x2} set a {} $z {set i 1} {$i<6} {incr i} $x1$bb$x2 set a } {x1} test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body { set z for catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set" ("for" loop-end command) invoked from within "$z {set i 0} {$i < 5} {set} {set j 4}"} test for-6.14 {Tcl_ForObjCmd: long command body} { set z for set a {} $z {set i 1} {$i<6} {incr i} { if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ |
Changes to tests/foreach.test.
1 2 3 4 5 6 | # Commands covered: foreach, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # Commands covered: foreach, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
161 162 163 164 165 166 167 | lsort [foo x] } [lsort {{0 zero} {1 one} {2 two} {3 three}}] test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} { catch {unset x} foreach {12.0} {a b c} { set x 12.0 | | | 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | lsort [foo x] } [lsort {{0 zero} {1 one} {2 two} {3 three}}] test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} { catch {unset x} foreach {12.0} {a b c} { set x 12.0 set x [expr {$x + 1}] } set x } 13.0 # Check "continue". test foreach-5.1 {continue tests} {catch continue} 4 |
︙ | ︙ |
Changes to tests/format.test.
1 2 3 4 5 6 | # Commands covered: format # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | > > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # Commands covered: format # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1994 The Regents of the University of California. # Copyright © 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # %u output depends on word length, so this test is not portable. 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 {![info exists ::env(CI_BUILD_WITH_MSVC)]}] 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} |
︙ | ︙ | |||
98 99 100 101 102 103 104 | 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} { |
︙ | ︙ | |||
136 137 138 139 140 141 142 143 144 145 146 147 | } {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} |
︙ | ︙ | |||
374 375 376 377 378 379 380 | set msg } {expected integer but got "xyz"} # Since "%zd" and "%td" are equivalent to "%lld" in 64-bit platforms and # equivalent to "%d" in 32-bit platforms, they are really not useful in # scripts, therefore they are not documented. It's intended use is through # the function Tcl_AppendPrintfToObj (et al). test format-8.24 {Undocumented formats} -body { | | | | | | 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 | set msg } {expected integer but got "xyz"} # Since "%zd" and "%td" are equivalent to "%lld" in 64-bit platforms and # equivalent to "%d" in 32-bit platforms, they are really not useful in # scripts, therefore they are not documented. It's intended use is through # the function Tcl_AppendPrintfToObj (et al). test format-8.24 {Undocumented formats} -body { format "%zd %td %d" [expr {2**30}] [expr {2**30}] [expr {2**30}] } -result {1073741824 1073741824 1073741824} test format-8.25 {Undocumented formats} -constraints pointerIs64bit -body { format "%zd %td %lld" [expr {2**33}] [expr {2**33}] [expr {2**33}] } -result {8589934592 8589934592 8589934592} # Since "%p" is equivalent to "%#llx" in 64-bit platforms and equivalent # to "%#x" in 32-bit platforms, it are really not useful in scripts, # therefore they are not documented. It's intended use is through the # function Tcl_AppendPrintfToObj (et al). test format-8.26 {Undocumented formats} -body { format "%p %#x" [expr {2**31}] [expr {2**31}] } -result {0x80000000 0x80000000} test format-8.27 {Undocumented formats} -constraints pointerIs64bit -body { format "%p %#llx" [expr {2**33}] [expr {2**33}] } -result {0x200000000 0x200000000} test format-9.1 {long result} { set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} format {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG %s %s} $a $a } {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} |
︙ | ︙ | |||
462 463 464 465 466 467 468 | catch {unset a} catch {unset b} catch {unset c} catch {unset d} set a 0.0000000000001 set b 0.00000000000001 set c 0.00000000000000001 | | | | | | | 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 | catch {unset a} catch {unset b} catch {unset c} catch {unset d} set a 0.0000000000001 set b 0.00000000000001 set c 0.00000000000000001 set d [expr {$a + $b + $c}] format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d } {0.0000000000 0.000000000000 0.000000000000110 0.00000000000011001} test format-13.2 {tcl_precision fuzzy comparison} { catch {unset a} catch {unset b} catch {unset c} catch {unset d} set a 0.000000000001 set b 0.000000000000005 set c 0.0000000000000008 set d [expr {$a + $b + $c}] format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d } {0.0000000000 0.000000000001 0.000000000001006 0.00000000000100580} test format-13.3 {tcl_precision fuzzy comparison} { catch {unset a} catch {unset b} catch {unset c} set a 0.00000000000099 set b 0.000000000000011 set c [expr {$a + $b}] format {%0.10f %0.12f %0.15f %0.17f} $c $c $c $c } {0.0000000000 0.000000000001 0.000000000001001 0.00000000000100100} test format-13.4 {tcl_precision fuzzy comparison} { catch {unset a} catch {unset b} catch {unset c} set a 0.444444444444 set b 0.33333333333333 set c [expr {$a + $b}] format {%0.10f %0.12f %0.15f %0.16f} $c $c $c $c } {0.7777777778 0.777777777777 0.777777777777330 0.7777777777773300} test format-13.5 {tcl_precision fuzzy comparison} { catch {unset a} catch {unset b} catch {unset c} set a 0.444444444444 set b 0.99999999999999 set c [expr {$a + $b}] format {%0.10f %0.12f %0.15f} $c $c $c } {1.4444444444 1.444444444444 1.444444444443990} test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} { format {%s} "" } {} test format-14.2 {testing MAX_FLOAT_SIZE for 0 and 1} { |
︙ | ︙ | |||
536 537 538 539 540 541 542 | set a "0123456789" set b "" for {set i 0} {$i < 290} {incr i} { append b $a } for {set i 290} {$i < 400} {incr i} { | | | 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 | set a "0123456789" set b "" for {set i 0} {$i < 290} {incr i} { append b $a } for {set i 290} {$i < 400} {incr i} { test format-16.[expr {$i -289}] {testing MAX_FLOAT_SIZE} { format {%s} $b } $b append b "x" } test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} { format %d 7810179016327718216 |
︙ | ︙ |
Changes to tests/get.test.
1 2 3 4 5 6 | # Commands covered: none # # This file contains a collection of tests for the procedures in the # file tclGet.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # Commands covered: none # # This file contains a collection of tests for the procedures in the # file tclGet.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1995-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testgetint [llength [info commands testgetint]] testConstraint testdoubleobj [llength [info commands testdoubleobj]] testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] test get-1.1 {Tcl_GetInt procedure} testgetint { |
︙ | ︙ | |||
106 107 108 109 110 111 112 | test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} { catch {testdoubleobj set 1 $x} x set x } } {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} test get-3.5 {tcl_GetInt with numeric whitespace (i.e. '_')} testgetint { | | | | 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} { catch {testdoubleobj set 1 $x} x set x } } {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} test get-3.5 {tcl_GetInt with numeric whitespace (i.e. '_')} testgetint { lmap x {0_0 " 1_0" "0_2 " " 3_3 " 14__23__32___4 " 0x_a " 0b1111_1111 " 0_07 " " 0o_1_0 " " 0b_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } { catch {testgetint $x} x set x } } {0 10 2 33 1423324 10 255 7 8 2 {expected integer but got " 0_b1_0 "} {expected integer but got "_33"} {expected integer but got "42_"} {expected integer but got "0_x15"} {expected integer but got "0_o17"} {expected integer but got "0_d19"}} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/history.test.
1 2 3 4 5 6 | # Commands covered: history # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: history # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
36 37 38 39 40 41 42 | # "history event" test history-1.1 {event option} history {history event -1} \ {set b [format {A test %s} string]} test history-1.2 {event option} history {history event $num} \ {set a 12345} | | | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | # "history event" test history-1.1 {event option} history {history event -1} \ {set b [format {A test %s} string]} test history-1.2 {event option} history {history event $num} \ {set a 12345} test history-1.3 {event option} history {history event [expr {$num+2}]} \ {Another test} test history-1.4 {event option} history {history event set} \ {set b [format {A test %s} string]} test history-1.5 {event option} history {history e "* a*"} \ {set a 12345} test history-1.6 {event option} history {catch {history event *gorp} msg} 1 test history-1.7 {event option} history { |
︙ | ︙ | |||
145 146 147 148 149 150 151 | history add set\ c\ {a\nb\nc} } test history-5.1 {info option} history {history info} [format {%6d set a {b c d e} %6d set b 1234 %6d set c {a b | | | | | > > | 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 | history add set\ c\ {a\nb\nc} } test history-5.1 {info option} history {history info} [format {%6d set a {b c d e} %6d set b 1234 %6d set c {a b c}} $num [expr {$num+1}] [expr {$num+2}]] test history-5.2 {info option} history {history i 2} [format {%6d set b 1234 %6d set c {a b c}} [expr {$num+1}] [expr {$num+2}]] test history-5.3 {info option} history {catch {history i 2 3}} 1 test history-5.4 {info option} history { catch {history i 2 3} msg set msg } {wrong # args: should be "history info ?count?"} test history-5.5 {info option} history {history} [format {%6d set a {b c d e} %6d set b 1234 %6d set c {a b c}} $num [expr {$num+1}] [expr {$num+2}]] # "history keep" if {[testConstraint history]} { history add "foo1" history add "foo2" history add "foo3" history keep 2 } test history-6.1 {keep option} history { history event [expr {[history n]-1}] } foo3 test history-6.2 {keep option} history {history event -1} foo2 test history-6.3 {keep option} history {catch {history event -3}} 1 test history-6.4 {keep option} history { catch {history event -3} msg set msg } {event "-3" is too far in the past} if {[testConstraint history]} { |
︙ | ︙ | |||
212 213 214 215 216 217 218 | if {[testConstraint history]} { set num [history n] history add "Testing" history add "Testing2" } test history-7.1 {nextid option} history {history event} "Testing" | | | 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 | if {[testConstraint history]} { set num [history n] history add "Testing" history add "Testing2" } test history-7.1 {nextid option} history {history event} "Testing" test history-7.2 {nextid option} history {history next} [expr {$num+2}] test history-7.3 {nextid option} history {catch {history nextid garbage}} 1 test history-7.4 {nextid option} history { catch {history nextid garbage} msg set msg } {wrong # args: should be "history nextid"} # "history clear" |
︙ | ︙ | |||
258 259 260 261 262 263 264 | # Ignore the references due to calling this procedure return [expr {$rc - 3}] } } } -body { histtest eval { # A fresh object, refcount 1 from the variable we write it to | | | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | # Ignore the references due to calling this procedure return [expr {$rc - 3}] } } } -body { histtest eval { # A fresh object, refcount 1 from the variable we write it to set obj [expr {rand()}] set baseline [refcount $obj] lappend result [refcount $obj] history add [list list $obj] lappend result [refcount $obj] history clear lappend result [refcount $obj] } |
︙ | ︙ | |||
284 285 286 287 288 289 290 | # Ignore the references due to calling this procedure return [expr {$rc - 3}] } } } -body { histtest eval { # A fresh object, refcount 1 from the variable we write it to | | | 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 | # Ignore the references due to calling this procedure return [expr {$rc - 3}] } } } -body { histtest eval { # A fresh object, refcount 1 from the variable we write it to set obj [expr {rand()}] set baseline [refcount $obj] lappend result [refcount $obj] history add [list list $obj] lappend result [refcount $obj] rename history {} lappend result [refcount $obj] } |
︙ | ︙ |
Changes to tests/http.test.
1 2 3 4 5 6 | # Commands covered: http::config, http::geturl, http::wait, http::reset # # This file contains a collection of tests for the http script library. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: http::config, http::geturl, http::wait, http::reset # # This file contains a collection of tests for the http script library. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
34 35 36 37 38 39 40 | proc bgerror {args} { global errorInfo puts stderr "http.test bgerror" puts stderr [join $args] puts stderr $errorInfo } | | | > | < < < < | | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | proc bgerror {args} { global errorInfo puts stderr "http.test bgerror" puts stderr [join $args] 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]} { |
︙ | ︙ | |||
120 121 122 123 124 125 126 | test http-3.1 {http::geturl} -returnCodes error -body { http::geturl -bogus flag } -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate} test http-3.2 {http::geturl} -returnCodes error -body { http::geturl http:junk } -result {Unsupported URL: http:junk} set url //${::HOST}:$port | | | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | test http-3.1 {http::geturl} -returnCodes error -body { http::geturl -bogus flag } -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate} test http-3.2 {http::geturl} -returnCodes error -body { http::geturl http:junk } -result {Unsupported URL: http:junk} set url //${::HOST}:$port set badurl //${::HOST}:[expr {$port+1}] test http-3.3 {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { http::cleanup $token } -result "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> |
︙ | ︙ | |||
619 620 621 622 623 624 625 | 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] |
︙ | ︙ | |||
649 650 651 652 653 654 655 | 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 { |
︙ | ︙ | |||
714 715 716 717 718 719 720 | ::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 |
︙ | ︙ | |||
874 875 876 877 878 879 880 | } {-> $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 "!"} |
︙ | ︙ | |||
1044 1045 1046 1047 1048 1049 1050 | } {-> $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 |
︙ | ︙ | |||
1083 1084 1085 1086 1087 1088 1089 | } -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/httpcookie.test.
1 2 3 4 5 6 | # Commands covered: http::cookiejar # # This file contains a collection of tests for the cookiejar package. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | < < < | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: http::cookiejar # # This file contains a collection of tests for the cookiejar package. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 2014 Donal K. Fellows. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands testConstraint notMacCI [expr {![info exists ::env(MAC_CI)]}] testConstraint sqlite3 [expr {[testConstraint notMacCI] && ![catch { package require sqlite3 }]}] testConstraint cookiejar [expr {[testConstraint sqlite3] && ![catch { package require cookiejar }]}] set COOKIEJAR_VERSION 0.2.0 |
︙ | ︙ |
Changes to tests/httpd.
1 2 3 4 | # -*- tcl -*- # # The httpd_ procedures implement a stub http server. # | | | | | > | < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # -*- tcl -*- # # The httpd_ procedures implement a stub http server. # # Copyright © 1997-1998 Sun Microsystems, Inc. # Copyright © 1999-2000 Scriptics Corporation # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #set httpLog 1 # Do not use [info hostname]. # Name resolution is often a problem on OSX; not focus of HTTP package anyway. # Also a problem on other platforms for http-4.14 (test with bad port number). set HOST localhost proc httpd_init {{port 8015}} { set s [socket -server httpdAccept $port] # Save the actual port number in a global variable. # This is important when we're called with port 0 # for picking an unused port at random. set ::port [lindex [chan configure $s -sockname] 2] |
︙ | ︙ |
Changes to tests/httpd11.tcl.
1 2 3 4 5 6 7 8 9 10 | # httpd11.tcl -- -*- tcl -*- # # A simple httpd for testing HTTP/1.1 client features. # Not suitable for use on a internet connected port. # # Copyright (C) 2009 Pat Thoyts <[email protected]> # # 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 | # httpd11.tcl -- -*- tcl -*- # # A simple httpd for testing HTTP/1.1 client features. # Not suitable for use on a internet connected port. # # Copyright (C) 2009 Pat Thoyts <[email protected]> # # 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} { if {[dict exists $dict $key]} { return [dict get $dict $key] } return } |
︙ | ︙ |
Changes to tests/if-old.test.
1 2 3 4 5 6 7 8 | # Commands covered: if # # This file contains the original set of tests for Tcl's if command. # Since the if command is now compiled, a new set of tests covering # the new implementation is in the file "if.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # Commands covered: if # # This file contains the original set of tests for Tcl's if command. # Since the if command is now compiled, a new set of tests covering # the new implementation is in the file "if.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/if.test.
1 2 3 4 5 6 | # Commands covered: if # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # Commands covered: if # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
138 139 140 141 142 143 144 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
161 162 163 164 165 166 167 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } return $a } -cleanup { unset a |
︙ | ︙ | |||
235 236 237 238 239 240 241 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
258 259 260 261 262 263 264 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } elseif 1<2 then { #; this if arm should be taken set a 4 while {$a != "xxx"} { break; |
︙ | ︙ | |||
283 284 285 286 287 288 289 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 5 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
306 307 308 309 310 311 312 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 6 } return $a } -cleanup { unset a |
︙ | ︙ | |||
385 386 387 388 389 390 391 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
408 409 410 411 412 413 414 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } elseif 1==2 then { #; this if arm should be taken set a 4 while {$a != "xxx"} { break; |
︙ | ︙ | |||
433 434 435 436 437 438 439 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 5 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
456 457 458 459 460 461 462 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 6 } else { set a 7 while {$a != "xxx"} { break; |
︙ | ︙ | |||
481 482 483 484 485 486 487 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 8 while {$a != "xxx"} { break; while {$i >= 0} { if {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
504 505 506 507 508 509 510 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 | set i $i set i [lindex $s $i] } if {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 9 } return $a } -cleanup { unset a |
︙ | ︙ | |||
709 710 711 712 713 714 715 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
732 733 734 735 736 737 738 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } return $a } -cleanup { unset a z |
︙ | ︙ | |||
812 813 814 815 816 817 818 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
835 836 837 838 839 840 841 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } elseif 1<2 then { #; this if arm should be taken set a 4 while {$a != "xxx"} { break; |
︙ | ︙ | |||
860 861 862 863 864 865 866 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 5 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
883 884 885 886 887 888 889 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 6 } return $a } -cleanup { unset a z |
︙ | ︙ | |||
971 972 973 974 975 976 977 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 2 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
994 995 996 997 998 999 1000 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 3 } elseif 1==2 then { #; this if arm should be taken set a 4 while {$a != "xxx"} { break; |
︙ | ︙ | |||
1019 1020 1021 1022 1023 1024 1025 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 5 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
1042 1043 1044 1045 1046 1047 1048 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 6 } else { set a 7 while {$a != "xxx"} { break; |
︙ | ︙ | |||
1067 1068 1069 1070 1071 1072 1073 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 8 while {$a != "xxx"} { break; while {$i >= 0} { $z {[string compare $a "bar"] < 0} { |
︙ | ︙ | |||
1090 1091 1092 1093 1094 1095 1096 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } | | | 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 | set i $i set i [lindex $s $i] } $z {[string compare $a "bar"] < 0} { set i $i set i [lindex $s $i] } incr i -1 } } set a 9 } return $a } -cleanup { unset a z |
︙ | ︙ |
Changes to tests/incr-old.test.
1 2 3 4 5 6 7 8 | # Commands covered: incr # # This file contains the original set of tests for Tcl's incr command. # Since the incr command is now compiled, a new set of tests covering # the new implementation is in the file "incr.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # Commands covered: incr # # This file contains the original set of tests for Tcl's incr command. # Since the incr command is now compiled, a new set of tests covering # the new implementation is in the file "incr.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/incr.test.
1 2 3 4 5 6 | # Commands covered: incr # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # Commands covered: incr # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/indexObj.test.
1 2 3 4 | # This file is a Tcl script to test out the the procedures in file # tkIndexObj.c, which implement indexed table lookups. The tests here are # organized in the standard fashion for Tcl tests. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # This file is a Tcl script to test out the the procedures in file # tkIndexObj.c, which implement indexed table lookups. The tests here are # organized in the standard fashion for Tcl tests. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 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} |
︙ | ︙ |
Changes to tests/info.test.
1 2 3 4 5 6 7 | # -*- tcl -*- # Commands covered: info # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # -*- tcl -*- # Commands covered: info # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1994 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2006 ActiveState # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # 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]] # 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} |
︙ | ︙ | |||
321 322 323 324 325 326 327 | set y [info level 1] list $x $y } t1 146 testString } {1 {t1 146 testString}} test info-9.3 {info level option} { proc t1 {a b} { | | | 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 | set y [info level 1] list $x $y } t1 146 testString } {1 {t1 146 testString}} test info-9.3 {info level option} { proc t1 {a b} { t2 [expr {$a*2}] $b } proc t2 {x y} { list [info level] [info level 1] [info level 2] [info level -1] \ [info level 0] } t1 146 {a {b c} {{{c}}}} } {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}} |
︙ | ︙ | |||
653 654 655 656 657 658 659 | namespace eval x info vars foo } -cleanup { namespace delete x } -result {} set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isfinite isinf isnan isnormal isqrt issubnormal isunordered log log10 max min pow rand round sin sinh sqrt srand tan tanh wide} # Check whether the extra testing functions are defined... | | | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 | namespace eval x info vars foo } -cleanup { namespace delete x } -result {} set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isfinite isinf isnan isnormal isqrt issubnormal isunordered log log10 max min pow rand round sin sinh sqrt srand tan tanh wide} # Check whether the extra testing functions are defined... if {!([catch {expr {T1()}} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} { set functions "T1 T2 T3 $functions" ;# A lazy way of prepending! } test info-20.1 {info functions option} {info functions sin} sin test info-20.2 {info functions option} {lsort [info functions]} $functions test info-20.3 {info functions option} { lsort [info functions a*] } {abs acos asin atan atan2} |
︙ | ︙ |
Changes to tests/init.test.
1 2 3 4 5 6 | # Functionality covered: this file contains a collection of tests for the auto # loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # Functionality covered: this file contains a collection of tests for the auto # loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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/internals.tcl.
1 2 3 4 5 6 | # This file contains internal facilities for Tcl tests. # # Source this file in the related tests to include from tcl-tests: # # source [file join [file dirname [info script]] internals.tcl] # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # This file contains internal facilities for Tcl tests. # # Source this file in the related tests to include from tcl-tests: # # source [file join [file dirname [info script]] internals.tcl] # # Copyright © 2020 Sergey G. Brester (sebres). # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[namespace which -command ::tcltest::internals::scriptpath] eq ""} {namespace eval ::tcltest::internals { namespace path ::tcltest |
︙ | ︙ |
Changes to tests/interp.test.
1 2 3 4 5 6 | # This file tests the multiple interpreter facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # This file tests the multiple interpreter facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1995-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testinterpdelete [llength [info commands testinterpdelete]] set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempdir tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload} foreach i [interp children] { interp delete $i |
︙ | ︙ | |||
101 102 103 104 105 106 107 | test interp-2.11 {anonymous interps vs existing procs} { set x [interp create] regexp "interp(\[0-9]+)" $x dummy thenum interp delete $x proc interp$thenum {} {} set x [interp create] regexp "interp(\[0-9]+)" $x dummy anothernum | | | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | test interp-2.11 {anonymous interps vs existing procs} { set x [interp create] regexp "interp(\[0-9]+)" $x dummy thenum interp delete $x proc interp$thenum {} {} set x [interp create] regexp "interp(\[0-9]+)" $x dummy anothernum expr {$anothernum > $thenum} } 1 test interp-2.12 {anonymous interps vs existing procs} { set x [interp create -safe] regexp "interp(\[0-9]+)" $x dummy thenum interp delete $x proc interp$thenum {} {} set x [interp create -safe] regexp "interp(\[0-9]+)" $x dummy anothernum expr {$anothernum - $thenum} } 1 test interp-2.13 {correct default when no $path arg is given} -body { interp create -- } -match regexp -result {interp[0-9]+} foreach i [interp children] { interp delete $i |
︙ | ︙ | |||
220 221 222 223 224 225 226 | } 0 # Recreate interpreter "a" interp create a # Part 5: Testing eval in interpreter object command and with interp command test interp-6.1 {testing eval} { | | | | | | 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 | } 0 # Recreate interpreter "a" interp create a # Part 5: Testing eval in interpreter object command and with interp command test interp-6.1 {testing eval} { a eval expr {{3 + 5}} } 8 test interp-6.2 {testing eval} -returnCodes error -body { a eval foo } -result {invalid command name "foo"} test interp-6.3 {testing eval} { a eval {proc foo {} {expr {3 + 5}}} a eval foo } 8 catch {a eval {proc foo {} {expr {3 + 5}}}} test interp-6.4 {testing eval} { interp eval a foo } 8 test interp-6.5 {testing eval} { interp create {a x2} interp eval {a x2} {proc frob {} {expr {4 * 9}}} interp eval {a x2} frob } 36 catch {interp create {a x2}} test interp-6.6 {testing eval} -returnCodes error -body { interp eval {a x2} foo } -result {invalid command name "foo"} |
︙ | ︙ | |||
742 743 744 745 746 747 748 | } "" test interp-16.5 {testing deletion order, bgerror} { catch {interp delete xxx} interp create xxx xxx eval {proc bgerror {args} {exit}} xxx alias exit kill xxx proc kill {i} {interp delete $i} | | | 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 | } "" test interp-16.5 {testing deletion order, bgerror} { catch {interp delete xxx} interp create xxx xxx eval {proc bgerror {args} {exit}} xxx alias exit kill xxx proc kill {i} {interp delete $i} xxx eval after 100 expr {a + b} after 200 update interp exists xxx } 0 # # Alias loop prevention testing. |
︙ | ︙ | |||
962 963 964 965 966 967 968 | set l } {foo {}} test interp-19.9 {alias deletion, renaming} { catch {interp delete a} interp create a interp alias a foo a bar interp eval a rename foo blotz | | | 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 | set l } {foo {}} test interp-19.9 {alias deletion, renaming} { catch {interp delete a} interp create a interp alias a foo a bar interp eval a rename foo blotz interp eval a {proc foo {} {expr {34 * 34}}} interp alias a foo {} set l [interp eval a foo] interp delete a set l } 1156 test interp-20.1 {interp hide, interp expose and interp invokehidden} { |
︙ | ︙ | |||
3167 3168 3169 3170 3171 3172 3173 | set while while $while {1} { # No bytecode at all here... } } } # We use a time limit here; command limits don't trap this case | | | 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 | set while while $while {1} { # No bytecode at all here... } } } # We use a time limit here; command limits don't trap this case $i limit time -seconds [expr {[clock seconds] + 2}] $i eval foobar } -returnCodes error -result {time limit exceeded} -cleanup { interp delete $i } test interp-34.4 {limits with callbacks: extending limits} -setup { set i [interp create] set a 0 |
︙ | ︙ | |||
3189 3190 3191 3192 3193 3194 3195 | global c i set c b $i limit command -value $newlimit } } -body { interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] | | | | 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 | global c i set c b $i limit command -value $newlimit } } -body { interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] $i limit command -command "cb2 [expr {$curlim + 100}]" \ -value [expr {$curlim + 10}] $i eval {for {set i 0} {$i<10} {incr i} {foo}} list $a $b $c } -result {6 4 b} -cleanup { interp delete $i rename cb1 {} rename cb2 {} } |
︙ | ︙ | |||
3218 3219 3220 3221 3222 3223 3224 | global c i set c b $i limit command -value $newlimit } } -body { interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] | | | 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 | global c i set c b $i limit command -value $newlimit } } -body { interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] $i limit command -command "cb2 {}" -value [expr {$curlim + 10}] $i eval {for {set i 0} {$i<10} {incr i} {foo}} list $a $b $c } -result {6 4 b} -cleanup { interp delete $i rename cb1 {} rename cb2 {} } |
︙ | ︙ | |||
3243 3244 3245 3246 3247 3248 3249 | global c i set c b $i limit command -value {} -command {} } } -body { interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] | | | | 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 | global c i set c b $i limit command -value {} -command {} } } -body { interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] $i limit command -command cb2 -value [expr {$curlim + 10}] $i eval {for {set i 0} {$i<10} {incr i} {foo}} list $a $b $c } -result {6 4 b} -cleanup { interp delete $i rename cb1 {} rename cb2 {} } test interp-34.7 {limits with callbacks: deleting the handler interp} -setup { set i [interp create] $i eval { set i [interp create] proc cb1 {} { global c incr ::$c } proc cb2 {args} { global c i curlim set c b $i limit command -value [expr {$curlim + 1000}] trapToParent } } proc cb3 {} { global i subi interp alias [list $i $subi] foo {} cb4 interp delete $i |
︙ | ︙ | |||
3285 3286 3287 3288 3289 3290 3291 | set n 0 $i eval { set a 0 set b 0 set c a interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] | | | | 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 | set n 0 $i eval { set a 0 set b 0 set c a interp alias $i foo {} cb1 set curlim [$i eval info cmdcount] $i limit command -command cb2 -value [expr {$curlim + 10}] } $i eval { $i eval { for {set i 0} {$i<10} {incr i} {foo} } } list $n [interp exists $i] } -result {4 0} -cleanup { rename cb3 {} rename cb4 {} } # Bug 1085023 test interp-34.8 {time limits trigger in vwaits} -body { set i [interp create] interp limit $i time -seconds [expr {[clock seconds] + 1}] -granularity 1 $i eval { set x {} vwait x } } -cleanup { interp delete $i } -returnCodes error -result {limit exceeded} |
︙ | ︙ | |||
3348 3349 3350 3351 3352 3353 3354 | proc cb2 {} { global result lappend result cb2 } } -body { set i [interp create] set t0 [clock seconds] | | | | 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 | proc cb2 {} { global result lappend result cb2 } } -body { set i [interp create] set t0 [clock seconds] $i limit time -seconds [expr {$t0 + 1}] -granularity 1 \ -command "cb1 $i [expr {$t0 + 2}]" set ::result {} lappend ::result [catch { $i eval { for {set i 0} {$i<30} {incr i} { after 100 } } |
︙ | ︙ | |||
3376 3377 3378 3379 3380 3381 3382 | lappend result cb1 set times [lassign $times t] $i limit time -seconds $t } } -body { set i [interp create] set t0 [clock seconds] | | | | 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 | lappend result cb1 set times [lassign $times t] $i limit time -seconds $t } } -body { set i [interp create] set t0 [clock seconds] set ::times "[expr {$t0 + 2}] [expr {$t0 + 100}]" $i limit time -seconds [expr {$t0 + 1}] -granularity 1 -command "cb1 $i" set ::result {} lappend ::result [catch { $i eval { for {set i 0} {$i<30} {incr i} { after 100 } } |
︙ | ︙ | |||
3520 3521 3522 3523 3524 3525 3526 | interp delete $i } -returnCodes error -result {expected integer but got "foobar"} test interp-35.19 {interp limit syntax} -body { set i [interp create] interp limit $i time -seconds -1 } -cleanup { interp delete $i | | | | 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 | interp delete $i } -returnCodes error -result {expected integer but got "foobar"} test interp-35.19 {interp limit syntax} -body { set i [interp create] interp limit $i time -seconds -1 } -cleanup { interp delete $i } -match glob -returnCodes error -result {seconds must be between 0 and *} test interp-35.20 {interp limit syntax} -body { set i [interp create] interp limit $i time -millis foobar } -cleanup { interp delete $i } -returnCodes error -result {expected integer but got "foobar"} test interp-35.21 {interp limit syntax} -body { set i [interp create] interp limit $i time -millis -1 } -cleanup { interp delete $i } -match glob -returnCodes error -result {milliseconds must be between 0 and *} test interp-35.22 {interp time limits normalize milliseconds} -body { set i [interp create] interp limit $i time -seconds 1 -millis 1500 list [$i limit time -seconds] [$i limit time -millis] } -cleanup { interp delete $i } -result {2 500} |
︙ | ︙ | |||
3611 3612 3613 3614 3615 3616 3617 | test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup { catch {interp delete a} interp create a set result {} } -body { interp create {a b} -safe | | | | 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 | test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup { catch {interp delete a} interp create a set result {} } -body { interp create {a b} -safe lappend result [interp eval a {expr {min(5,2,3)*max(7,13,11)}}] lappend result [interp eval {a b} {expr {min(5,2,3)*max(7,13,11)}}] } -cleanup { unset -nocomplain result interp delete a } -result {26 26} test interp-38.1 {interp debug one-way switch} -setup { catch {interp delete a} |
︙ | ︙ |
Changes to tests/io.test.
1 2 3 4 5 6 7 8 | # -*- tcl -*- # Functionality covered: operation of all IO commands, and all procedures # defined in generic/tclIO.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # -*- tcl -*- # Functionality covered: operation of all IO commands, and all procedures # defined in generic/tclIO.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1994 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 } |
︙ | ︙ | |||
27 28 29 30 31 32 33 | variable n variable v variable msg variable expected catch { ::tcltest::loadTestedCommands | | | > > > | | 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 | variable n variable v variable msg variable expected catch { ::tcltest::loadTestedCommands package require -exact tcl::test [info patchlevel] set ::tcltestlib [info loaded {} Tcltest] } package require tcltests testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testobj [llength [info commands testobj]] testConstraint testservicemode [llength [info commands testservicemode]] # Some things fail under Windows in Continuous Integration systems for subtle # reasons such as CI often running with elevated privileges in a container. 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 |
︙ | ︙ | |||
70 71 72 73 74 75 76 | close $f set path(cat) [makeFile { set f stdin if {$argv != ""} { set f [open [lindex $argv 0]] } | | | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | close $f set path(cat) [makeFile { set f stdin if {$argv != ""} { set f [open [lindex $argv 0]] } fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A fconfigure stdout -encoding binary -translation lf -buffering none fileevent $f readable "foo $f" proc foo {f} { set x [read $f] catch {puts -nonewline $x} if {[eof $f]} { close $f |
︙ | ︙ | |||
101 102 103 104 105 106 107 | 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. |
︙ | ︙ | |||
288 289 290 291 292 293 294 | 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 |
︙ | ︙ | |||
444 445 446 447 448 449 450 | 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] |
︙ | ︙ | |||
492 493 494 495 496 497 498 | fconfigure $f -blocking 0 set x [gets $f line] close $f set x } {-1} test io-6.8 {Tcl_GetsObj: remember if EOF is seen} { set f [open $path(test1) w] | | | | | | 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 | fconfigure $f -blocking 0 set x [gets $f line] close $f set x } {-1} test io-6.8 {Tcl_GetsObj: remember if EOF is seen} { set f [open $path(test1) w] puts $f "abcdef\x1Aghijk\nwombat" 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 } {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} # Comprehensive tests test io-6.10 {Tcl_GetsObj: lf mode: no chars} { set f [open $path(test1) w] |
︙ | ︙ | |||
888 889 890 891 892 893 894 | fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 | | | | 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 | fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 puts -nonewline $f "\nabcd\refg\x1A" lappend x [gets $f line] $line [testchannel queuedcr $f] lappend x [gets $f line] $line close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fileevent} { # not (*eol == '\n') set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 puts -nonewline $f "abcd\refg\x1A" lappend x [gets $f line] $line [testchannel queuedcr $f] lappend x [gets $f line] $line close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel fileevent} { # Tcl_ExternalToUtf() |
︙ | ︙ | |||
939 940 941 942 943 944 945 | fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 gets $f fconfigure $f -blocking 0 set x [list [gets $f line] $line [testchannel queuedcr $f]] fconfigure $f -blocking 1 | | | 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 | fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 gets $f fconfigure $f -blocking 0 set x [list [gets $f line] $line [testchannel queuedcr $f]] fconfigure $f -blocking 1 puts -nonewline $f "\n\x1A" lappend x [gets $f line] $line [testchannel queuedcr $f] close $f set x } [list 15 "123456789abcdef" 1 -1 "" 0] test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} { # (eol == dstEnd) |
︙ | ︙ | |||
1011 1012 1013 1014 1015 1016 1017 | set x } [list "123456" 7 "78901"] test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} { # if (eof != NULL) set f [open $path(test1) w] fconfigure $f -translation lf | | | | 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 | set x } [list "123456" 7 "78901"] test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} { # if (eof != NULL) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\x1Ak9012345\r" close $f set f [open $path(test1)] fconfigure $f -eofchar \x1A set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]] close $f set x } [list "123456" 0 6 ""] test io-6.53 {Tcl_GetsObj: device EOF} { # didn't produce any bytes |
︙ | ︙ | |||
1045 1046 1047 1048 1049 1050 1051 | 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 {} |
︙ | ︙ | |||
1079 1080 1081 1082 1083 1084 1085 | } {{} 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" |
︙ | ︙ | |||
1233 1234 1235 1236 1237 1238 1239 | # Make sure bytes are removed from buffer. set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} -buffering none puts -nonewline $f "abcdefghijklmno\r" # here set x [list [gets $f line] $line [testchannel queuedcr $f]] | | | 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 | # Make sure bytes are removed from buffer. set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} -buffering none puts -nonewline $f "abcdefghijklmno\r" # here set x [list [gets $f line] $line [testchannel queuedcr $f]] puts -nonewline $f "\x1A" lappend x [gets $f line] $line close $f set x } {15 abcdefghijklmno 1 -1 {}} test io-9.1 {CommonGetsCleanup} emptyTest { } {} |
︙ | ︙ | |||
1408 1409 1410 1411 1412 1413 1414 | 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 } |
︙ | ︙ | |||
1447 1448 1449 1450 1451 1452 1453 | 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 {} |
︙ | ︙ | |||
1490 1491 1492 1493 1494 1495 1496 | 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 {} |
︙ | ︙ | |||
1517 1518 1519 1520 1521 1522 1523 | 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 |
︙ | ︙ | |||
1725 1726 1727 1728 1729 1730 1731 | 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 |
︙ | ︙ | |||
1936 1937 1938 1939 1940 1941 1942 | # channels are added to the channel table of the interpreter. test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stdin] eof stdin interp create x set l "" | | | | | | | | | | | 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 | # channels are added to the channel table of the interpreter. test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stdin] eof stdin interp create x set l "" lappend l [expr {[testchannel refcount stdin] - $l1}] x eval {eof stdin} lappend l [expr {[testchannel refcount stdin] - $l1}] interp delete x lappend l [expr {[testchannel refcount stdin] - $l1}] set l } {0 1 0} test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stdout] eof stdin interp create x set l "" lappend l [expr {[testchannel refcount stdout] - $l1}] x eval {eof stdout} lappend l [expr {[testchannel refcount stdout] - $l1}] interp delete x lappend l [expr {[testchannel refcount stdout] - $l1}] set l } {0 1 0} test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stderr] eof stdin interp create x set l "" lappend l [expr {[testchannel refcount stderr] - $l1}] x eval {eof stderr} lappend l [expr {[testchannel refcount stderr] - $l1}] interp delete x lappend l [expr {[testchannel refcount stderr] - $l1}] set l } {0 1 0} test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { file delete -force $path(test1) set l "" set f [open $path(test1) w] |
︙ | ︙ | |||
2067 2068 2069 2070 2071 2072 2073 | set x } {ascii} test io-20.2 {Tcl_CreateChannel: initial settings} {win} { set f [open $path(test1) w+] set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] close $f set x | | | 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 | set x } {ascii} test io-20.2 {Tcl_CreateChannel: initial settings} {win} { set f [open $path(test1) w+] set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] close $f set x } [list [list \x1A ""] {auto crlf}] test io-20.3 {Tcl_CreateChannel: initial settings} {unix} { set f [open $path(test1) w+] set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] close $f set x } {{{} {}} {auto lf}} set path(stdout) [makeFile {} stdout] |
︙ | ︙ | |||
2154 2155 2156 2157 2158 2159 2160 | } {6 6 0 6} test io-26.1 {Tcl_GetChannelInstanceData} stdio { # "pid" command uses Tcl_GetChannelInstanceData # Don't care what pid is (but must be a number), just want to exercise it. set f [open "|[list [interpreter] << exit]"] | | | 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 | } {6 6 0 6} test io-26.1 {Tcl_GetChannelInstanceData} stdio { # "pid" command uses Tcl_GetChannelInstanceData # Don't care what pid is (but must be a number), just want to exercise it. set f [open "|[list [interpreter] << exit]"] expr {[pid $f]} close $f } {} # Test flushing. The functions tested here are FlushChannel. test io-27.1 {FlushChannel, no output buffered} { file delete $path(test1) |
︙ | ︙ | |||
2226 2227 2228 2229 2230 2231 2232 | close $f lappend l [file size $path(test1)] set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ | | | 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 | close $f lappend l [file size $path(test1)] set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ {stdio asyncPipeClose notWinCI} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f { |
︙ | ︙ | |||
2339 2340 2341 2342 2343 2344 2345 | } 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]] \ |
︙ | ︙ | |||
2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 | } 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] |
︙ | ︙ | |||
2830 2831 2832 2833 2834 2835 2836 | # allow a little time for the background process to close. # otherwise, the following test fails on the [file delete $path(output)] # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ | | | 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 | # allow a little time for the background process to close. # otherwise, the following test fails on the [file delete $path(output)] # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ {stdio asyncPipeClose notWinCI} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f {fconfigure $f -translation lf} |
︙ | ︙ | |||
3155 3156 3157 3158 3159 3160 3161 | } close $f set f [open $path(test1) r] fconfigure $f -translation auto set c [read $f] close $f string length $c | | | | | | | | | | 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 | } close $f set f [open $path(test1) r] fconfigure $f -translation auto set c [read $f] close $f string length $c } [expr {700*15+1}] test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line } close $f set f [open $path(test1) r] fconfigure $f -translation crlf set c [read $f] close $f string length $c } [expr {700*15+1}] test io-30.15 {Tcl_Write mixed, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] fconfigure $f -translation auto set c [read $f] close $f set c } {hello there and here } 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] |
︙ | ︙ | |||
3281 3282 3283 3284 3285 3286 3287 | lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l | | | | | | | | | | | 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 | 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 \x1Aghi 0 qrs 0 {} 1" test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar {} set l "" set x [gets $f] lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {0 1 {} 1} test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar {} set l "" set x [gets $f] lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {0 1 {} 1} test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} # Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets. |
︙ | ︙ | |||
3729 3730 3731 3732 3733 3734 3735 | 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 |
︙ | ︙ | |||
3818 3819 3820 3821 3822 3823 3824 | lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l | | | 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 | 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 \x1Aqrs 0 tuv 0 {} 1" test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f |
︙ | ︙ | |||
3840 3841 3842 3843 3844 3845 3846 | lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l | | | 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 | 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 \x1Aqrs 0 tuv 0 {} 1" test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f |
︙ | ︙ | |||
3862 3863 3864 3865 3866 3867 3868 | lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l | | | | | | | | | 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 | 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 \x1Aqrs 0 tuv 0 {} 1" test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} { 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.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} { 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 lf -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.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} 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.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr -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.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} 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.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf -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 |
︙ | ︙ | |||
3989 3990 3991 3992 3993 3994 3995 | fconfigure $f -translation crlf set c "" while {[gets $f line] >= 0} { append c $line\n } close $f string length $c | | | | 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 | fconfigure $f -translation crlf set c "" while {[gets $f line] >= 0} { append c $line\n } close $f string length $c } [expr {700*15+1}] test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line } close $f set f [open $path(test1) r] fconfigure $f -translation auto set c "" while {[gets $f line] >= 0} { append c $line\n } close $f string length $c } [expr {700*15+1}] # Test Tcl_Read and buffering. test io-32.1 {Tcl_Read, channel not readable} { list [catch {read stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} test io-32.2 {Tcl_Read, zero byte count} { |
︙ | ︙ | |||
4842 4843 4844 4845 4846 4847 4848 | lappend l [eof $f] close $f set l } {{} 1} test io-35.6 {Tcl_Eof, eof char, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] | | | | | | | | | | | | | | | | | | | | 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 | lappend l [eof $f] close $f set l } {{} 1} test io-35.6 {Tcl_Eof, eof char, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.7 {Tcl_Eof, eof char, lf write, lf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.8 {Tcl_Eof, eof char, cr write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.9 {Tcl_Eof, eof char, cr write, cr read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {11 8 1} test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {11 8 1} test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {21 8 1} test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {21 8 1} test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) |
︙ | ︙ | |||
5030 5031 5032 5033 5034 5035 5036 | set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {8 8 1 13} test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] | | | | | | 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 | set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {8 8 1 13} test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {9 8 1 13} test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1A puts $f {} close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {2 1 1 13} test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) |
︙ | ︙ | |||
5078 5079 5080 5081 5082 5083 5084 | set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] | | | | 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 | set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $c $l $e [scan [string index $in end] %c] } -result {17 8 1 13} test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format \n%cqrsuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $c $l $e [scan [string index $in end] %c] } {9 1 1 13} # Test Tcl_InputBlocked |
︙ | ︙ | |||
5304 5305 5306 5307 5308 5309 5310 | 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 |
︙ | ︙ | |||
5472 5473 5474 5475 5476 5477 5478 | 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 |
︙ | ︙ | |||
5634 5635 5636 5637 5638 5639 5640 | close $f set x } {zzy abzzy} test io-40.2 {POSIX open access modes: CREAT} {unix} { file delete $path(test3) set f [open $path(test3) {WRONLY CREAT} 0o600] file stat $path(test3) stats | | | | | 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 | close $f set x } {zzy abzzy} test io-40.2 {POSIX open access modes: CREAT} {unix} { file delete $path(test3) set f [open $path(test3) {WRONLY CREAT} 0o600] file stat $path(test3) stats set x [format "%#o" [expr {$stats(mode)&0o777}]] puts $f "line 1" close $f set f [open $path(test3) r] lappend x [gets $f] close $f set x } {0o600 {line 1}} test io-40.3 {POSIX open access modes: CREAT} {unix umask} { # This test only works if your umask is 2, like ouster's. file delete $path(test3) set f [open $path(test3) {WRONLY CREAT}] close $f file stat $path(test3) stats format 0o%03o [expr {$stats(mode)&0o777}] } [format 0o%03o [expr {0o666 & ~ $umaskValue}]] test io-40.4 {POSIX open access modes: CREAT} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f -eofchar {} puts $f xyzzy close $f set f [open $path(test3) {WRONLY CREAT}] |
︙ | ︙ | |||
5823 5824 5825 5826 5827 5828 5829 | 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} { |
︙ | ︙ | |||
6356 6357 6358 6359 6360 6361 6362 | lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] | | | 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 | 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.5 {lf write, testing readability, ^Z in middle, auto read mode} {fileevent} { file delete $path(test1) |
︙ | ︙ | |||
6384 6385 6386 6387 6388 6389 6390 | 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) |
︙ | ︙ | |||
6412 6413 6414 6415 6416 6417 6418 | lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] | | | 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 | 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.7 {cr write, testing readability, ^Z in middle, auto read mode} {fileevent} { file delete $path(test1) |
︙ | ︙ | |||
6440 6441 6442 6443 6444 6445 6446 | 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) |
︙ | ︙ | |||
6468 6469 6470 6471 6472 6473 6474 | lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] | | | 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 | 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.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fileevent} { file delete $path(test1) |
︙ | ︙ | |||
6496 6497 6498 6499 6500 6501 6502 | 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) |
︙ | ︙ | |||
6524 6525 6526 6527 6528 6529 6530 | 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) |
︙ | ︙ | |||
6552 6553 6554 6555 6556 6557 6558 | lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] | | | 6619 6620 6621 6622 6623 6624 6625 6626 6627 6628 6629 6630 6631 6632 6633 | 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.12 {cr write, testing readability, ^Z in middle, cr read mode} {fileevent} { file delete $path(test1) |
︙ | ︙ | |||
6580 6581 6582 6583 6584 6585 6586 | 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) |
︙ | ︙ | |||
6608 6609 6610 6611 6612 6613 6614 | lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] | | | 6675 6676 6677 6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 6688 6689 | 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.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {fileevent} { file delete $path(test1) |
︙ | ︙ | |||
6636 6637 6638 6639 6640 6641 6642 | 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) |
︙ | ︙ | |||
6664 6665 6666 6667 6668 6669 6670 | lappend l [gets $f] incr c } } set c 0 set l "" set f [open $path(test1) r] | | | 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 | 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-49.1 {testing crlf reading, leftover cr disgorgment} { |
︙ | ︙ | |||
7150 7151 7152 7153 7154 7155 7156 | } {0 0 ok} test io-52.6 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 | | | 7217 7218 7219 7220 7221 7222 7223 7224 7225 7226 7227 7228 7229 7230 7231 | } {0 0 ok} test io-52.6 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 set s0 [fcopy $f1 $f2 -size [expr {[file size $thisScript] + 5}]] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { lappend result ok |
︙ | ︙ | |||
7211 7212 7213 7214 7215 7216 7217 | # 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] |
︙ | ︙ | |||
7263 7264 7265 7266 7267 7268 7269 | 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] |
︙ | ︙ | |||
7574 7575 7576 7577 7578 7579 7580 | set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0] set in [open $thisScript] ;# 126 K set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]] catch {unset fcopyTestDone} close $listen ;# This means the socket open never really succeeds fcopy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone | | | | 7641 7642 7643 7644 7645 7646 7647 7648 7649 7650 7651 7652 7653 7654 7655 7656 7657 7658 7659 7660 7661 7662 7663 7664 7665 7666 7667 7668 7669 7670 7671 7672 7673 7674 | set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0] set in [open $thisScript] ;# 126 K set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]] catch {unset fcopyTestDone} close $listen ;# This means the socket open never really succeeds fcopy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g. } close $in close $out set fcopyTestDone ;# 1 for error condition } 1 test io-53.6 {CopyData: error during fcopy} {stdio fcopy} { variable fcopyTestDone file delete $path(pipe) file delete $path(test1) catch {unset fcopyTestDone} set f1 [open $path(pipe) w] puts $f1 "exit 1" close $f1 set in [open "|[list [interpreter] $path(pipe)]" r+] set out [open $path(test1) w] fcopy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } catch {close $in} close $out set fcopyTestDone ;# 0 for plain end of file } {0} proc doFcopy {in out {bytes 0} {error {}}} { |
︙ | ︙ | |||
7640 7641 7642 7643 7644 7645 7646 | exit 0 } close $f1 set in [open "|[list [interpreter] $path(pipe) &]" r+] set out [open $path(test1) w] doFcopy $in $out variable fcopyTestDone | | | | 7707 7708 7709 7710 7711 7712 7713 7714 7715 7716 7717 7718 7719 7720 7721 7722 7723 7724 7725 7726 7727 | exit 0 } close $f1 set in [open "|[list [interpreter] $path(pipe) &]" r+] set out [open $path(test1) w] doFcopy $in $out variable fcopyTestDone if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } catch {close $in} close $out # -1=error 0=script error N=number of bytes expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1} } {3450} test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { # copy progress callback. errors out intentionally proc ::cmd args { lappend ::RES "CMD $args" error !STOP } |
︙ | ︙ | |||
8128 8129 8130 8131 8132 8133 8134 | list [gets $c] [chan copy $c $outChan -size 100] [gets $c] } -cleanup { close $outChan close $c removeFile out } -result {line 100 line} | | | 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 8206 8207 8208 8209 | list [gets $c] [chan copy $c $outChan -size 100] [gets $c] } -cleanup { close $outChan close $c removeFile out } -result {line 100 line} test io-54.1 {Recursive channel events} {socket fileevent notWinCI} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. proc accept {s a p} { variable as fconfigure $s -translation lf puts $s "line 1\nline2\nline3" |
︙ | ︙ | |||
8383 8384 8385 8386 8387 8388 8389 | 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] |
︙ | ︙ | |||
8741 8742 8743 8744 8745 8746 8747 | 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.
1 2 3 4 5 6 7 8 | # -*- tcl -*- # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush, # fblocked, fconfigure, open, channel, fcopy # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # -*- tcl -*- # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush, # fblocked, fconfigure, open, channel, fcopy # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1994 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 # Custom constraints used in this file testConstraint testchannel [llength [info commands testchannel]] #---------------------------------------------------------------------- |
︙ | ︙ | |||
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/ioTrans.test.
1 2 3 4 5 6 7 | # -*- tcl -*- # Functionality covered: operation of the reflected transformation # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # -*- tcl -*- # Functionality covered: operation of the reflected transformation # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 2007 Andreas Kupries <[email protected]> # <[email protected]> # # 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]] # Custom constraints used in this file testConstraint testchannel [llength [info commands testchannel]] testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] # testchannel cut|splice Both needed to test the reflection in threads. # thread::send |
︙ | ︙ |
Changes to tests/iogt.test.
1 2 3 4 5 6 7 8 | # -*- tcl -*- # Commands covered: transform, and stacking in general # # This file contains a collection of tests for Giot # # 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 | # -*- tcl -*- # Commands covered: transform, and stacking in general # # This file contains a collection of tests for Giot # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright © 2000 Ajuba Solutions. # Copyright © 2000 Andreas Kupries. # All rights reserved. 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]] namespace eval ::tcl::test::iogt { namespace import ::tcltest::* testConstraint testchannel [llength [info commands testchannel]] set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-= |
︙ | ︙ |
Changes to tests/join.test.
1 2 3 4 5 6 | # Commands covered: join # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: join # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/lindex.test.
1 2 3 4 5 6 | # Commands covered: lindex # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | # Commands covered: lindex # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2001 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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]] set minus - testConstraint testevalex [llength [info commands testevalex]] # Tests of Tcl_LindexObjCmd, NOT COMPILED test lindex-1.1 {wrong # args} testevalex { |
︙ | ︙ |
Changes to tests/link.test.
1 2 3 4 5 6 | # Commands covered: none # # This file contains a collection of tests for Tcl_LinkVar and related library # procedures. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: none # # This file contains a collection of tests for Tcl_LinkVar and related library # procedures. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testlink [llength [info commands testlink]] testConstraint testlinkarray [llength [info commands testlinkarray]] foreach i {int real bool string} { unset -nocomplain $i } |
︙ | ︙ |
Changes to tests/linsert.test.
1 2 3 4 5 6 | # Commands covered: linsert # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: linsert # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/list.test.
1 2 3 4 5 6 | # Commands covered: list # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: list # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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 |
︙ | ︙ | |||
94 95 96 97 98 99 100 | concat {} # Check that tclListObj.c's SetListFromAny handles possible overlarge # string rep lengths in the source object. proc slowsort list { set result {} | | | | | | | | | 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 | concat {} # Check that tclListObj.c's SetListFromAny handles possible overlarge # string rep lengths in the source object. proc slowsort list { set result {} set last [expr {[llength $list] - 1}] while {$last > 0} { set minIndex [expr {[llength $list] - 1}] set min [lindex $list $last] set i [expr {$minIndex - 1}] while {$i >= 0} { if {[string compare [lindex $list $i] $min] < 0} { set minIndex $i set min [lindex $list $i] } incr i -1 } set result [concat $result [list $min]] if {$minIndex == 0} { set list [lrange $list 1 end] } else { set list [concat [lrange $list 0 [expr {$minIndex - 1}]] \ [lrange $list [expr {$minIndex + 1}] end]] } set last [expr {$last - 1}] } return [concat $result $list] } test list-3.1 {SetListFromAny and lrange/concat results} { slowsort {fred julie alex carol bill annie} } {alex annie bill carol fred julie} |
︙ | ︙ |
Changes to tests/listObj.test.
1 2 3 4 5 6 7 | # Functionality covered: operation of the procedures in tclListObj.c that # implement the Tcl type manager for the list object type. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Functionality covered: operation of the procedures in tclListObj.c that # implement the Tcl type manager for the list object type. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1995-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] catch {unset x} test listobj-1.1 {Tcl_GetListObjType} emptyTest { # Test removed; tested an internal detail # that's no longer correct, and duplicated test obj-1.1 |
︙ | ︙ |
Changes to tests/llength.test.
1 2 3 4 5 6 | # Commands covered: llength # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: llength # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/lmap.test.
1 2 3 4 5 6 | # Commands covered: lmap, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: lmap, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 2011 Trevor Davel # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ if {"::tcltest" ni [namespace children]} { |
︙ | ︙ | |||
353 354 355 356 357 358 359 | }} x] } -result [lsort {{0 zero} {1 one} {2 two} {3 three}}] test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} -setup { unset -nocomplain x } -body { lmap {12.0} {a b c} { set x 12.0 | | | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 | }} x] } -result [lsort {{0 zero} {1 one} {2 two} {3 three}}] test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} -setup { unset -nocomplain x } -body { lmap {12.0} {a b c} { set x 12.0 set x [expr {$x + 1}] } } -result {13.0 13.0 13.0} # Test for incorrect "double evaluation" semantics test lmap-7.3 {delayed substitution of body} { apply {{} { set a 0 lmap a [list 1 2 3] " |
︙ | ︙ |
Changes to tests/load.test.
1 2 3 4 5 6 | # Commands covered: load # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < > | | | > < | | | | | | | | | | | | | | | | | | | | | | > | | | | < | < < | > | > | | | | | | | < < | | | | < | | | < | | | > > | < | > > > | < | | | > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # Commands covered: load # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1995 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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]] # Figure out what extension is used for shared libraries on this # platform. if {![info exists ext]} { set ext [info sharedlibextension] } # Tests require the existence of one of the DLLs in the dltest directory. set testDir [file join [file dirname [info nameofexecutable]] dltest] set x [file join $testDir pkga$ext] set dll "[file tail $x]Required" testConstraint $dll [file readable $x] # 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 { load } -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"} test load-1.2 {basic errors} -returnCodes error -body { load a b c d } -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"} test load-1.3 {basic errors} -returnCodes error -body { load a b foobar } -result {could not find interpreter "foobar"} test load-1.4 {basic errors} -returnCodes error -body { load -global {} } -result {must specify either file name or prefix} test load-1.5 {basic errors} -returnCodes error -body { load -lazy {} {} } -result {must specify either file name or prefix} test load-1.6 {basic errors} -returnCodes error -body { load {} Unknown } -result {no library with prefix "Unknown" is loaded statically} test load-1.7 {basic errors} -returnCodes error -body { load -abc foo } -result {bad option "-abc": must be -global, -lazy, or --} test load-1.8 {basic errors} -returnCodes error -body { load -global } -result {couldn't figure out prefix for -global} test load-2.1 {basic loading, with guess for package name} \ [list $dll $loaded] { load -global [file join $testDir pkga$ext] list [pkga_eq abc def] [lsort [info commands pkga_*]] } {0 {pkga_eq pkga_quote}} interp create -safe child test load-2.2 {loading into a safe interpreter, with package name conversion} \ [list $dll $loaded] { load -lazy [file join $testDir pkgb$ext] Pkgb child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \ -body { list [catch {load [file join $testDir pkgc$ext] Foo} msg] $msg $errorCode } -match glob \ -result [list 1 {cannot find symbol "Foo_Init"*} \ {TCL LOOKUP LOAD_SYMBOL *Foo_Init}] test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg } {1 {can't use library in a safe interpreter: no Pkga_SafeInit procedure}} test load-3.1 {error in _Init procedure, same interpreter} \ [list $dll $loaded] { list [catch {load [file join $testDir pkge$ext] Pkge} msg] \ $msg $::errorInfo $::errorCode } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory while executing "open non_existent" invoked from within "if 44 {open non_existent}" invoked from within "load [file join $testDir pkge$ext] Pkge"} {POSIX ENOENT {no such file or directory}}} test load-3.2 {error in _Init procedure, child interpreter} \ [list $dll $loaded] { catch {interp delete x} interp create x set ::errorCode foo set ::errorInfo bar set result [list [catch {load [file join $testDir pkge$ext] Pkge x} msg] \ $msg $::errorInfo $::errorCode] interp delete x set result } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory while executing "open non_existent" invoked from within "if 44 {open non_existent}" invoked from within "load [file join $testDir pkge$ext] Pkge x"} {POSIX ENOENT {no such file or directory}}} test load-4.1 {reloading package into same interpreter} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] Pkga} msg] $msg } {0 {}} test load-4.2 {reloading package into same interpreter} -setup { catch {load [file join $testDir pkga$ext] Pkga} } -constraints [list $dll $loaded] -returnCodes error -body { load [file join $testDir pkga$ext] Pkgb } -result "file \"[file join $testDir pkga$ext]\" is already loaded for prefix \"Pkga\"" test load-5.1 {file name not specified and no static package: pick default} -setup { catch {interp delete x} interp create x } -constraints [list $dll $loaded] -body { load -global [file join $testDir pkga$ext] Pkga load {} Pkga x info loaded x } -cleanup { interp delete x } -result [list [list [file join $testDir pkga$ext] Pkga]] # On some platforms, like SunOS 4.1.3, these tests can't be run because # they cause the process to exit. # # 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}}} test load-10.1 {load from vfs} -setup { set dir [pwd] cd $testDir testsimplefilesystem 1 } -constraints [list $dll $loaded testsimplefilesystem] -body { list [catch {load simplefs:/pkgd$ext Pkgd} msg] $msg } -result {0 {}} -cleanup { testsimplefilesystem 0 cd $dir unset dir } test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \ [list $dll $loaded] { load [file join $testDir pkgooa$ext] list [pkgooa_stubsok] [lsort [info commands pkgooa_*]] } {1 pkgooa_stubsok} |
︙ | ︙ |
Changes to tests/lpop.test.
1 2 3 4 5 6 | # Commands covered: lpop # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: lpop # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/lrange.test.
1 2 3 4 5 6 | # Commands covered: lrange # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: lrange # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testpurebytesobj [llength [info commands testpurebytesobj]] test lrange-1.1 {range of list elements} { lrange {a b c d} 1 2 } {b c} test lrange-1.2 {range of list elements} { |
︙ | ︙ |
Changes to tests/lrepeat.test.
1 2 3 4 5 6 | # Commands covered: lrepeat # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # Commands covered: lrepeat # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 2003 Simon Geard. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/lreplace.test.
1 2 3 4 5 6 | # Commands covered: lreplace # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: lreplace # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/lsearch.test.
1 2 3 4 5 6 | # Commands covered: lsearch # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: lsearch # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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 |
︙ | ︙ | |||
380 381 382 383 384 385 386 | lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a* } {3 5} test lsearch-14.8 {combinations: -start, -inline and -not} { lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {c4} test lsearch-15.1 {make sure no shimmering occurs} { | | | 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 | lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a* } {3 5} test lsearch-14.8 {combinations: -start, -inline and -not} { lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {c4} test lsearch-15.1 {make sure no shimmering occurs} { set x [expr {int(sin(0))}] lsearch -start $x $x $x } 0 test lsearch-16.1 {lsearch -regexp shared object} { set str a lsearch -regexp $str $str } 0 |
︙ | ︙ |
Changes to tests/lset.test.
1 2 3 4 5 6 7 8 | # This file is a -*- tcl -*- test script # Commands covered: lset # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # This file is a -*- tcl -*- test script # Commands covered: lset # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 2001 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] proc failTrace {name1 name2 op} { error "trace failed" } testConstraint testevalex [llength [info commands testevalex]] |
︙ | ︙ |
Changes to tests/lsetComp.test.
1 2 3 4 5 6 7 8 | # This file is a -*- tcl -*- test script # Commands covered: lset # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # This file is a -*- tcl -*- test script # Commands covered: lset # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 2001 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/macOSXFCmd.test.
1 2 3 4 5 6 | # This file tests the tclMacOSXFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # This file tests the tclMacOSXFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 2003 Tcl Core Team. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/macOSXLoad.test.
1 2 3 4 5 6 | # Commands covered: load unload # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # Commands covered: load unload # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1995 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/main.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # This file contains a collection of tests for generic/tclMain.c. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } namespace eval ::tcl::test::main { namespace import ::tcltest::* # Is [exec] defined? testConstraint exec [llength [info commands exec]] | | < < | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # This file contains a collection of tests for generic/tclMain.c. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } namespace eval ::tcl::test::main { namespace import ::tcltest::* # Is [exec] defined? testConstraint exec [llength [info commands exec]] # Is the tcl::test package loaded? testConstraint tcl::test [expr { [llength [package provide tcl::test]] && [package vsatisfies [package provide tcl::test] 8.5-]}] # Procedure to simulate interactive typing of commands, line by line proc type {chan script} { foreach line [split $script \n] { if {[catch { puts $chan $line flush $chan |
︙ | ︙ | |||
66 67 68 69 70 71 72 | } -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 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 | } -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 } -cleanup { close $f removeFile script } -result {0 {-enc utf-8 script}} # Tests Tcl_Main-2.*: application-initialization procedure test Tcl_Main-2.1 { Tcl_Main: appInitProc returns error } -constraints { exec tcl::test } -setup { makeFile {puts "In script"} script } -body { exec [interpreter] script -appinitprocerror >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile script } -result "application-specific initialization failed: \nIn script\n" test Tcl_Main-2.2 { Tcl_Main: appInitProc returns error } -constraints { exec tcl::test } -body { exec [interpreter] << {puts "In script"} -appinitprocerror >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "application-specific initialization failed: \nIn script\n" test Tcl_Main-2.3 { Tcl_Main: appInitProc deletes interp } -constraints { exec tcl::test } -setup { makeFile {puts "In script"} script } -body { exec [interpreter] script -appinitprocdeleteinterp >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile script } -result "application-specific initialization failed: \n" test Tcl_Main-2.4 { Tcl_Main: appInitProc deletes interp } -constraints { exec tcl::test } -body { exec [interpreter] << {puts "In script"} \ -appinitprocdeleteinterp >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "application-specific initialization failed: \n" test Tcl_Main-2.5 { Tcl_Main: appInitProc closes stderr } -constraints { exec tcl::test } -body { exec [interpreter] << {puts "In script"} \ -appinitprocclosestderr >& result set f [open result] read $f } -cleanup { close $f |
︙ | ︙ | |||
332 333 334 335 336 337 338 | removeFile script } -match glob -result [join [list 1 {child process exited abnormally}\ "missing close-brace\n while executing*"] \n] test Tcl_Main-3.5 { Tcl_Main: startup script sets main loop } -constraints { | | | 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 | removeFile script } -match glob -result [join [list 1 {child process exited abnormally}\ "missing close-brace\n while executing*"] \n] test Tcl_Main-3.5 { Tcl_Main: startup script sets main loop } -constraints { exec tcl::test } -setup { makeFile { rename exit _exit proc exit {code} { puts "In exit" _exit $code } |
︙ | ︙ | |||
360 361 362 363 364 365 366 | file delete result removeFile script } -result "event\nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-3.6 { Tcl_Main: startup script sets main loop and closes stdin } -constraints { | | | 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 | file delete result removeFile script } -result "event\nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-3.6 { Tcl_Main: startup script sets main loop and closes stdin } -constraints { exec tcl::test } -setup { makeFile { close stdin testsetmainloop rename exit _exit proc exit {code} { puts "In exit" |
︙ | ︙ | |||
389 390 391 392 393 394 395 | file delete result removeFile script } -result "event\nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-3.7 { Tcl_Main: startup script deletes interp } -constraints { | | | 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 | file delete result removeFile script } -result "event\nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-3.7 { Tcl_Main: startup script deletes interp } -constraints { exec tcl::test } -setup { makeFile { rename exit _exit proc exit {code} { puts "In exit" _exit $code } |
︙ | ︙ | |||
413 414 415 416 417 418 419 | file delete result removeFile script } -result "even 0\n" test Tcl_Main-3.8 { Tcl_Main: startup script deletes interp and sets mainloop } -constraints { | | | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 | file delete result removeFile script } -result "even 0\n" test Tcl_Main-3.8 { Tcl_Main: startup script deletes interp and sets mainloop } -constraints { exec tcl::test } -setup { makeFile { testsetmainloop rename exit _exit proc exit {code} { puts "In exit" _exit $code |
︙ | ︙ | |||
457 458 459 460 461 462 463 | } -result {} # Tests Tcl_Main-4.*: rc file evaluation test Tcl_Main-4.1 { Tcl_Main: rcFile evaluation deletes interp } -constraints { | | | | | 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 | } -result {} # Tests Tcl_Main-4.*: rc file evaluation test Tcl_Main-4.1 { Tcl_Main: rcFile evaluation deletes interp } -constraints { exec tcl::test } -setup { set rc [makeFile {testinterpdelete {}} rc] } -body { exec [interpreter] << {puts "In script"} \ -appinitprocsetrcfile $rc >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile rc } -result "application-specific initialization failed: \n" test Tcl_Main-4.2 { Tcl_Main: rcFile evaluation closes stdin } -constraints { exec tcl::test } -setup { set rc [makeFile {close stdin} rc] } -body { exec [interpreter] << {puts "In script"} \ -appinitprocsetrcfile $rc >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile rc } -result "application-specific initialization failed: \n" test Tcl_Main-4.3 { Tcl_Main: rcFile evaluation closes stdin and sets main loop } -constraints { exec tcl::test } -setup { set rc [makeFile { close stdin testsetmainloop after 0 testexitmainloop testexithandler create 0 rename exit _exit |
︙ | ︙ | |||
519 520 521 522 523 524 525 | removeFile rc } -result "application-specific initialization failed:\ \nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-4.4 { Tcl_Main: rcFile evaluation sets main loop } -constraints { | | | 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 | removeFile rc } -result "application-specific initialization failed:\ \nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-4.4 { Tcl_Main: rcFile evaluation sets main loop } -constraints { exec tcl::test } -setup { set rc [makeFile { testsetmainloop after 0 testexitmainloop testexithandler create 0 rename exit _exit proc exit code { |
︙ | ︙ | |||
546 547 548 549 550 551 552 | removeFile rc } -result "application-specific initialization failed:\ \nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-4.5 { Tcl_Main: Bug 1481986 } -constraints { | | | 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 | removeFile rc } -result "application-specific initialization failed:\ \nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-4.5 { Tcl_Main: Bug 1481986 } -constraints { exec tcl::test } -setup { set rc [makeFile { testsetmainloop after 0 {puts "Event callback"} } rc] } -body { set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+] |
︙ | ︙ | |||
604 605 606 607 608 609 610 | 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 |
︙ | ︙ | |||
694 695 696 697 698 699 700 | file delete result } -result "bar\n" test Tcl_Main-5.8 { Tcl_Main: interactive mode: close stdin -> main loop & [exit] & exit handlers } -constraints { | | | 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 | file delete result } -result "bar\n" test Tcl_Main-5.8 { Tcl_Main: interactive mode: close stdin -> main loop & [exit] & exit handlers } -constraints { exec tcl::test } -body { exec [interpreter] << { rename exit _exit proc exit code { puts "In exit" _exit $code } |
︙ | ︙ | |||
718 719 720 721 722 723 724 | file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-5.9 { Tcl_Main: interactive mode: delete interp -> main loop & exit handlers, but no [exit] } -constraints { | | | 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 | file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-5.9 { Tcl_Main: interactive mode: delete interp -> main loop & exit handlers, but no [exit] } -constraints { exec tcl::test } -body { exec [interpreter] << { rename exit _exit proc exit code { puts "In exit" _exit $code } |
︙ | ︙ | |||
741 742 743 744 745 746 747 | close $f file delete result } -result "Exit MainLoop\neven 0\n" test Tcl_Main-5.10 { Tcl_Main: exit main loop in mid-interactive command } -constraints { | | | | 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 | close $f file delete result } -result "Exit MainLoop\neven 0\n" test Tcl_Main-5.10 { Tcl_Main: exit main loop in mid-interactive command } -constraints { exec tcl::test } -setup { catch {set f [open "|[list [interpreter]]" w+]} catch {chan configure $f -blocking 0} } -body { type $f "testsetmainloop after 2000 testexitmainloop puts \{1 2" after 4000 type $f "3 4\}" set code1 [catch {gets $f} line1] set code2 [catch {gets $f} line2] set code3 [catch {gets $f} line3] list $code1 $line1 $code2 $line2 $code3 $line3 } -cleanup { close $f } -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}] test Tcl_Main-5.11 { Tcl_Main: EOF in interactive main loop } -constraints { exec tcl::test } -body { exec [interpreter] << { rename exit _exit proc exit code { puts "In exit" _exit $code } |
︙ | ︙ | |||
784 785 786 787 788 789 790 | close $f file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-5.12 { Tcl_Main: close stdin in interactive main loop } -constraints { | | | 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 | close $f file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-5.12 { Tcl_Main: close stdin in interactive main loop } -constraints { exec tcl::test } -body { exec [interpreter] << { rename exit _exit proc exit code { puts "In exit" _exit $code } |
︙ | ︙ | |||
837 838 839 840 841 842 843 | close $f file delete result } -result "1\n% " test Tcl_Main-6.2 { Tcl_Main: prompt deletes interp } -constraints { | | | 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 | close $f file delete result } -result "1\n% " test Tcl_Main-6.2 { Tcl_Main: prompt deletes interp } -constraints { exec tcl::test } -body { exec [interpreter] << { set tcl_prompt1 {testinterpdelete {}} set tcl_interactive 1 puts "not reached" } >& result set f [open result] |
︙ | ︙ | |||
889 890 891 892 893 894 895 | close $f file delete result } -result "1\n% YES\n" test Tcl_Main-6.5 { Tcl_Main: interactive entry to main loop } -constraints { | | | 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 | close $f file delete result } -result "1\n% YES\n" test Tcl_Main-6.5 { Tcl_Main: interactive entry to main loop } -constraints { exec tcl::test } -body { exec [interpreter] << { set tcl_interactive 1 testsetmainloop testexitmainloop} >& result set f [open result] read $f |
︙ | ︙ | |||
939 940 941 942 943 944 945 | } -result "1\n% % " # Tests Tcl_Main-7.*: exiting test Tcl_Main-7.1 { Tcl_Main: [exit] defined as no-op -> still have exithandlers } -constraints { | | | | | | 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 | } -result "1\n% % " # Tests Tcl_Main-7.*: exiting test Tcl_Main-7.1 { Tcl_Main: [exit] defined as no-op -> still have exithandlers } -constraints { exec tcl::test } -body { exec [interpreter] << { proc exit args {} testexithandler create 0 } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "even 0\n" test Tcl_Main-7.2 { Tcl_Main: [exit] defined as no-op -> still have exithandlers } -constraints { exec tcl::test } -body { exec [interpreter] << { proc exit args {} testexithandler create 0 after 0 testexitmainloop testsetmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\neven 0\n" # Tests Tcl_Main-8.*: StdinProc operations test Tcl_Main-8.1 { StdinProc: handles non-blocking stdin } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop chan configure stdin -blocking 0 testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\n" test Tcl_Main-8.2 { StdinProc: handles stdin EOF } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop testexithandler create 0 rename exit _exit proc exit code { puts "In exit" |
︙ | ︙ | |||
1014 1015 1016 1017 1018 1019 1020 | close $f file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-8.3 { StdinProc: handles interactive stdin EOF } -constraints { | | | | 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 | close $f file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" test Tcl_Main-8.3 { StdinProc: handles interactive stdin EOF } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop testexithandler create 0 rename exit _exit proc exit code { puts "In exit" _exit $code } set tcl_interactive 1} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% even 0\n" test Tcl_Main-8.4 { StdinProc: handles stdin close } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop rename exit _exit proc exit code { puts "In exit" _exit $code |
︙ | ︙ | |||
1058 1059 1060 1061 1062 1063 1064 | close $f file delete result } -result "1\nExit MainLoop\nIn exit\n" test Tcl_Main-8.5 { StdinProc: handles interactive stdin close } -constraints { | | | 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 | close $f file delete result } -result "1\nExit MainLoop\nIn exit\n" test Tcl_Main-8.5 { StdinProc: handles interactive stdin close } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop set tcl_interactive 1 rename exit _exit proc exit code { puts "In exit" |
︙ | ︙ | |||
1082 1083 1084 1085 1086 1087 1088 | close $f file delete result } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n" test Tcl_Main-8.6 { StdinProc: handles event loop re-entry } -constraints { | | | | | | | | | | 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 | close $f file delete result } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n" test Tcl_Main-8.6 { StdinProc: handles event loop re-entry } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop after 100 {puts 1; set delay 1} vwait delay puts 2 testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n2\nExit MainLoop\n" test Tcl_Main-8.7 { StdinProc: handling of errors } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop error foo testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "foo\nExit MainLoop\n" test Tcl_Main-8.8 { StdinProc: handling of errors, closed stderr } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop close stderr error foo testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "Exit MainLoop\n" test Tcl_Main-8.9 { StdinProc: interactive output } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop set tcl_interactive 1 testexitmainloop} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% % Exit MainLoop\n" test Tcl_Main-8.10 { StdinProc: interactive output, closed stdout } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop close stdout set tcl_interactive 1 testexitmainloop } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result {} test Tcl_Main-8.11 { StdinProc: prompt deletes interp } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop set tcl_prompt1 {testinterpdelete {}} set tcl_interactive 1} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n" test Tcl_Main-8.12 { StdinProc: prompt closes stdin } -constraints { exec tcl::test } -body { exec [interpreter] << { testsetmainloop set tcl_prompt1 {close stdin} after 100 testexitmainloop set tcl_interactive 1 puts "not reached" } >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\nExit MainLoop\n" test Tcl_Main-8.13 { Bug 1775878 } -constraints { exec tcl::test } -body { exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result set f [open result] read $f } -cleanup { close $f file delete result |
︙ | ︙ |
Changes to tests/mathop.test.
1 2 3 4 5 6 | # Commands covered: ::tcl::mathop::... # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # Commands covered: ::tcl::mathop::... # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 2006 Donal K. Fellows # Copyright © 2006 Peter Spjuth # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
897 898 899 900 901 902 903 | foreach op {& | ^} { lappend res [TestOp $op {*}$vals] } } set exp {} foreach d {5 7 2 1 D C 1 F E 0 -D -D 8 -9 -1 -0 -E E} { if {[string match "-*" $d]} { | | | | | 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 | foreach op {& | ^} { lappend res [TestOp $op {*}$vals] } } set exp {} foreach d {5 7 2 1 D C 1 F E 0 -D -D 8 -9 -1 -0 -E E} { if {[string match "-*" $d]} { set d [format %X [expr {15-"0x[string range $d 1 end]"}]] set val [expr {-"0x[string repeat $d $dig]"-1}] } else { set val [expr {"0x[string repeat $d $dig]"}] } lappend exp $val } expr {$exp eq $res ? 1 : "($res != $exp"} } 1 test mathop-22.3 { bitwise ops } { set big1 12135435435354435435342423948763867876 |
︙ | ︙ |
Changes to tests/misc.test.
1 2 3 4 5 6 7 | # Commands covered: various # # This file contains a collection of miscellaneous Tcl tests that # don't fit naturally in any of the other test files. Many of these # tests are pathological cases that caused bugs in earlier Tcl # releases. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | # Commands covered: various # # This file contains a collection of miscellaneous Tcl tests that # don't fit naturally in any of the other test files. Many of these # tests are pathological cases that caused bugs in earlier Tcl # releases. # # Copyright © 1992-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testhashsystemhash [llength [info commands testhashsystemhash]] test misc-1.1 {error in variable ref. in command in array reference} { proc tstProc {} { global a |
︙ | ︙ |
Changes to tests/msgcat.test.
1 2 3 4 | # This file contains a collection of tests for the msgcat package. # Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | # This file contains a collection of tests for the msgcat package. # Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1998 Mark Harrison. # Copyright © 1998-1999 Scriptics Corporation. # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Note that after running these tests, entries will be left behind in the # message catalogs for locales foo, foo_BAR, and foo_BAR_baz. |
︙ | ︙ |
Changes to tests/namespace-old.test.
1 2 3 4 5 6 7 8 9 | # Functionality covered: this file contains slightly modified versions of # the original tests written by Mike McLennan of Lucent Technologies for # the procedures in tclNamesp.c that implement Tcl's basic support for # namespaces. Other namespace-related tests appear in namespace.test # and variable.test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # Functionality covered: this file contains slightly modified versions of # the original tests written by Mike McLennan of Lucent Technologies for # the procedures in tclNamesp.c that implement Tcl's basic support for # namespaces. Other namespace-related tests appear in namespace.test # and variable.test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1997 Lucent Technologies # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
749 750 751 752 753 754 755 | test namespace-old-9.14 {imported commands can be removed} { namespace forget test_ns_import::cmd? list [lsort [info commands cmd?]] \ [catch {cmd1 another test} msg] $msg } {{} 1 {invalid command name "cmd1"}} test namespace-old-9.15 {existing commands can't be overwritten} { proc cmd1 {x y} { | | | | 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 | test namespace-old-9.14 {imported commands can be removed} { namespace forget test_ns_import::cmd? list [lsort [info commands cmd?]] \ [catch {cmd1 another test} msg] $msg } {{} 1 {invalid command name "cmd1"}} test namespace-old-9.15 {existing commands can't be overwritten} { proc cmd1 {x y} { return [expr {$x+$y}] } list [catch {namespace import test_ns_import::cmd?} msg] $msg \ [cmd1 3 5] } {1 {can't import command "cmd1": already exists} 8} test namespace-old-9.16 {use "-force" option to override existing commands} { proc cmd1 {x y} { return [expr {$x+$y}] } list [cmd1 3 5] \ [namespace import -force test_ns_import::cmd?] \ [cmd1 3 5] } {8 {} {cmd1: 3 5}} test namespace-old-9.17 {commands can be imported into many namespaces} { namespace eval test_ns_import_use { namespace import ::test_ns_import::* ::test_ns_import2::ncmd? |
︙ | ︙ |
Changes to tests/namespace.test.
1 2 3 4 5 6 7 8 | # Functionality covered: this file contains a collection of tests for the # procedures in tclNamesp.c and tclEnsemble.c that implement Tcl's basic # support for namespaces. Other namespace-related tests appear in # variable.test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # Functionality covered: this file contains a collection of tests for the # procedures in tclNamesp.c and tclEnsemble.c that implement Tcl's basic # support for namespaces. Other namespace-related tests appear in # variable.test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-2000 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint memory [llength [info commands memory]] ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] # # REMARK: the tests for 'namespace upvar' are not done here. They are to be # found in the file 'upvar.test'. # # Clear out any namespaces called test_ns_* |
︙ | ︙ |
Changes to tests/notify.test.
1 2 3 4 5 6 7 8 9 10 | # -*- tcl -*- # # notify.test -- # # This file tests several functions in the file, 'generic/tclNotify.c'. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # -*- tcl -*- # # notify.test -- # # This file tests several functions in the file, 'generic/tclNotify.c'. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 2003 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testevent [llength [info commands testevent]] test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \ -constraints {testevent} \ -body { set delivered {} |
︙ | ︙ |
Changes to tests/nre.test.
1 2 3 4 5 6 | # Commands covered: proc, apply, [interp alias], [namespce import] # # This file contains a collection of tests for the non-recursive executor that # avoids recursive calls to TEBC. Only the NRE behaviour is tested here, the # actual command functionality is tested in the specific test file. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # Commands covered: proc, apply, [interp alias], [namespce import] # # This file contains a collection of tests for the non-recursive executor that # avoids recursive calls to TEBC. Only the NRE behaviour is tested here, the # actual command functionality is tested in the specific test file. # # Copyright © 2008 Miguel Sofer. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testnrelevels [llength [info commands testnrelevels]] # # The tests that risked blowing the C stack on failure have been removed: we # can now actually measure using testnrelevels. # |
︙ | ︙ |
Changes to tests/obj.test.
1 2 3 4 5 6 7 | # Functionality covered: this file contains a collection of tests for the # procedures in tclObj.c that implement Tcl's basic type support and the # type managers for the types boolean, double, and integer. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Functionality covered: this file contains a collection of tests for the # procedures in tclObj.c that implement Tcl's basic type support and the # type managers for the types boolean, double, and integer. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright © 1995-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 |
︙ | ︙ | |||
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/oo.test.
1 2 3 4 | # This file contains a collection of tests for Tcl's built-in object system. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # This file contains a collection of tests for Tcl's built-in object system. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 2006-2013 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcl::oo 1.0.3 if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # The foundational objects oo::object and oo::class are sensitive to reference # counting errors and are deallocated only when an interp is deleted, so in |
︙ | ︙ | |||
34 35 36 37 38 39 40 | return [expr {$end - $tmp}] } } test oo-0.1 {basic test of OO's ability to clean up its initial state} { interp create t t eval { | | | | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | return [expr {$end - $tmp}] } } test oo-0.1 {basic test of OO's ability to clean up its initial state} { interp create t t eval { package require tcl::oo } interp delete t } {} test oo-0.2 {basic test of OO's ability to clean up its initial state} { set i [interp create] interp eval $i { package require tcl::oo namespace delete :: } interp delete $i } {} test oo-0.3 {basic test of OO's ability to clean up its initial state} -body { leaktest { [oo::object new] destroy |
︙ | ︙ | |||
75 76 77 78 79 80 81 | interp delete foo } } 0 test oo-0.6 {cleaning the core class pair; way #1} -setup { interp create t } -body { t eval { | | | | | | | | 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 | interp delete foo } } 0 test oo-0.6 {cleaning the core class pair; way #1} -setup { interp create t } -body { t eval { package require tcl::oo namespace path oo list [catch {class destroy} m] $m [catch {object destroy} m] $m } } -cleanup { interp delete t } -result {0 {} 1 {invalid command name "object"}} test oo-0.7 {cleaning the core class pair; way #2} -setup { interp create t } -body { t eval { package require tcl::oo namespace path oo list [catch {object destroy} m] $m [catch {class destroy} m] $m } } -cleanup { interp delete t } -result {0 {} 1 {invalid command name "class"}} test oo-0.8 {leak in variable management} -setup { oo::class create foo } -constraints memory -body { oo::define foo { constructor {} { variable v 0 } } leaktest {[foo new] destroy} } -cleanup { foo destroy } -result 0 test oo-0.9 {various types of presence of the tcl::oo package} { list [lsearch -nocase -all -inline [package names] tcl::oo] \ [package present tcl::oo] [expr {$::oo::patchlevel in [package versions tcl::oo]}] } [list tcl::oo $::oo::patchlevel 1] test oo-1.1 {basic test of OO functionality: no classes} { set result {} lappend result [oo::object create foo] lappend result [oo::objdefine foo { method bar args { global result |
︙ | ︙ | |||
379 380 381 382 383 384 385 | } -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class} test oo-2.1 {basic test of OO functionality: constructor} -setup { # This is a bit complex because it needs to run in a sub-interp as # we're modifying the root object class's constructor interp create subinterp subinterp eval { | | | 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 | } -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class} test oo-2.1 {basic test of OO functionality: constructor} -setup { # This is a bit complex because it needs to run in a sub-interp as # we're modifying the root object class's constructor interp create subinterp subinterp eval { package require tcl::oo } } -body { subinterp eval { oo::define oo::object constructor {} { lappend ::result [info level 0] } lappend result 1 |
︙ | ︙ | |||
510 511 512 513 514 515 516 | } -result {{in A} ::a 1 {failure in A} {in B ::b} ::b 1 {failure in B}} test oo-3.1 {basic test of OO functionality: destructor} -setup { # This is a bit complex because it needs to run in a sub-interp as we're # modifying the root object class's constructor interp create subinterp subinterp eval { | | | | 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 | } -result {{in A} ::a 1 {failure in A} {in B ::b} ::b 1 {failure in B}} test oo-3.1 {basic test of OO functionality: destructor} -setup { # This is a bit complex because it needs to run in a sub-interp as we're # modifying the root object class's constructor interp create subinterp subinterp eval { package require tcl::oo } } -body { subinterp eval { oo::define oo::object destructor { lappend ::result died } lappend result 1 [oo::object create foo] lappend result 2 [rename foo {}] oo::define oo::object destructor {} return $result } } -cleanup { interp delete subinterp } -result {1 ::foo died 2 {}} test oo-3.2 {basic test of OO functionality: destructor} -setup { # This is a bit complex because it needs to run in a sub-interp as # we're modifying the root object class's constructor interp create subinterp subinterp eval { package require tcl::oo } } -body { subinterp eval { oo::define oo::object destructor { lappend ::result died } lappend result 1 [oo::object create foo] |
︙ | ︙ | |||
1963 1964 1965 1966 1967 1968 1969 | test oo-13.5 {OO: changing an object's class: non-class to class} -setup { oo::object create fooObj } -body { oo::objdefine fooObj { class oo::class } oo::define fooObj { | | | | 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 | test oo-13.5 {OO: changing an object's class: non-class to class} -setup { oo::object create fooObj } -body { oo::objdefine fooObj { class oo::class } oo::define fooObj { method x {} {expr {1+2+3}} } [fooObj new] x } -cleanup { fooObj destroy } -result 6 test oo-13.6 {OO: changing an object's class: class to non-class} -setup { oo::class create foo unset -nocomplain ::result } -body { set result dangling oo::define foo { method x {} {expr {1+2+3}} } oo::class create boo { superclass foo destructor {set ::result "ok"} } boo new foo create bar |
︙ | ︙ | |||
1998 1999 2000 2001 2002 2003 2004 | test oo-13.7 {OO: changing an object's class} -setup { oo::class create foo oo::class create bar unset -nocomplain result } -body { oo::define bar method x {} {return ok} oo::define foo { | | | | 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 | test oo-13.7 {OO: changing an object's class} -setup { oo::class create foo oo::class create bar unset -nocomplain result } -body { oo::define bar method x {} {return ok} oo::define foo { method x {} {expr {1+2+3}} self mixin foo } lappend result [foo x] oo::objdefine foo class bar lappend result [foo x] } -cleanup { foo destroy bar destroy } -result {6 ok} test oo-13.8 {OO: changing an object's class to itself} -setup { oo::class create foo } -body { oo::define foo { method x {} {expr {1+2+3}} } oo::objdefine foo class foo } -cleanup { foo destroy } -returnCodes error -result {may not change classes into an instance of themselves} test oo-13.9 {OO: changing an object's class: roots are special} -setup { set i [interp create] |
︙ | ︙ |
Changes to tests/ooNext2.test.
1 2 3 4 | # This file contains a collection of tests for Tcl's built-in object system. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # This file contains a collection of tests for Tcl's built-in object system. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 2006-2011 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcl::oo 1.0.3 if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { |
︙ | ︙ |
Changes to tests/ooUtil.test.
1 2 3 4 5 | # This file contains a collection of tests for functionality originally # sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs # the tests and generates output for errors. No output means no errors were # found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # This file contains a collection of tests for functionality originally # sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs # the tests and generates output for errors. No output means no errors were # found. # # Copyright © 2014-2016 Andreas Kupries # Copyright © 2018 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcl::oo 1.0.3 if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test ooUtil-1.1 {TIP 478: classmethod} -setup { oo::class create parent |
︙ | ︙ |
Changes to tests/opt.test.
1 2 3 4 5 6 | # Package covered: opt1.0/optparse.tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # Package covered: opt1.0/optparse.tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # the package we are going to test package require opt 0.4.8 # we are using implementation specifics to test the package #### functions tests ##### set n $::tcl::OptDescN test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} { list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr {$n+1}]] [::tcl::OptKeyRegister {}] } "$n [expr {$n+1}] [expr {$n+2}]" test opt-2.1 {OptKeyDelete} { list [::tcl::OptKeyRegister {} testkey] \ [info exists ::tcl::OptDesc(testkey)] \ [::tcl::OptKeyDelete testkey] \ [info exists ::tcl::OptDesc(testkey)] } {testkey 1 {} 0} |
︙ | ︙ |
Changes to tests/package.test.
1 2 3 4 5 6 7 | # This file contains tests for the package and ::pkg::* commands. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | # This file contains tests for the package and ::pkg::* commands. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1995-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2011 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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]] # Do all this in a child interp to avoid garbaging the package list set i [interp create] tcltest::loadIntoChildInterpreter $i {*}$argv catch [list load {} Tcltest $i] interp eval $i { namespace import -force ::tcltest::* |
︙ | ︙ | |||
1336 1337 1338 1339 1340 1341 1342 | } finally { interp delete $ip } } test package-13.0 {package prefer defaults} -body { prefer | | | 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 | } finally { interp delete $ip } } test package-13.0 {package prefer defaults} -body { prefer } -result [expr {[string match {*[ab]*} [package provide tcl]] ? "latest" : "stable"}] test package-13.1 {package prefer defaults} -body { set ::env(TCL_PKG_PREFER_LATEST) stable ;# value not relevant! prefer } -cleanup { unset -nocomplain ::env(TCL_PKG_PREFER_LATEST) } -result latest |
︙ | ︙ |
Changes to tests/parse.test.
1 2 3 4 | # This file contains a collection of tests for the procedures in the # file tclParse.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # This file contains a collection of tests for the procedures in the # file tclParse.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } namespace eval ::tcl::test::parse { namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testparser [llength [info commands testparser]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testevalobjv [llength [info commands testevalobjv]] testConstraint testevalex [llength [info commands testevalex]] testConstraint testparsevarname [llength [info commands testparsevarname]] 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 {}} |
︙ | ︙ | |||
274 275 276 277 278 279 280 | info complete {a [b {}c d]} } {1} test parse-6.9 {ParseTokens procedure, error in command substitution} { info complete {a [b "c d} } {0} test parse-6.10 {ParseTokens procedure, incomplete sub-command} { info complete {puts [ | | | 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 | info complete {a [b {}c d]} } {1} test parse-6.9 {ParseTokens procedure, error in command substitution} { info complete {a [b "c d} } {0} test parse-6.10 {ParseTokens procedure, incomplete sub-command} { info complete {puts [ expr {1+1} #this is a comment ]} } {0} test parse-6.11 {ParseTokens procedure, memory allocation for big nested command} testparser { testparser {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 } {- {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 word {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 command {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 {}} test parse-6.12 {ParseTokens procedure, missing close bracket} testparser { list [catch {testparser {[foo $x bar} 0} msg] $msg $::errorInfo |
︙ | ︙ | |||
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 |
︙ | ︙ | |||
477 478 479 480 481 482 483 | test parse-10.1 {Tcl_EvalTokens, simple text} testevalex { testevalex {concat test} } {test} test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex { testevalex {concat test\063\062test} } {test32test} test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { | | | | | | 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 | test parse-10.1 {Tcl_EvalTokens, simple text} testevalex { testevalex {concat test} } {test} test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex { testevalex {concat test\063\062test} } {test32test} test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { testevalex {concat [expr {2 + 6}]} } {8} test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex { unset -nocomplain a list [catch {testevalex {concat xxx[expr {$a}]}} msg] $msg } {1 {can't read "a": no such variable}} test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex { set a hello testevalex {concat $a} } {hello} test parse-10.6 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a set a(12) 46 testevalex {concat $a(12)} } {46} test parse-10.7 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a set a(12) 46 testevalex {concat $a(1[expr {3 - 1}])} } {46} test parse-10.8 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a list [catch {testevalex {concat $x($a)}} msg] $msg } {1 {can't read "a": no such variable}} test parse-10.9 {Tcl_EvalTokens, array variables} testevalex { unset -nocomplain a list [catch {testevalex {concat xyz$a(1)}} msg] $msg } {1 {can't read "a(1)": no such variable}} test parse-10.10 {Tcl_EvalTokens, object values} testevalex { set a 123 testevalex {concat $a} } {123} test parse-10.11 {Tcl_EvalTokens, object values} testevalex { set a 123 testevalex {concat $a$a$a} } {123123123} test parse-10.12 {Tcl_EvalTokens, object values} testevalex { testevalex {concat [expr {2}][expr {4}][expr {6}]} } {246} test parse-10.13 {Tcl_EvalTokens, string values} testevalex { testevalex {concat {a" b"}} } {a" b"} test parse-10.14 {Tcl_EvalTokens, string values} testevalex { set a 111 testevalex {concat x$a.$a.$a} |
︙ | ︙ | |||
681 682 683 684 685 686 687 | unset -nocomplain abc list [catch {testparsevar {$abc}} msg] $msg } {1 {can't read "abc": no such variable}} test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar { unset -nocomplain abc list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg } {1 {invalid command name "bogus"}} | | | 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 | unset -nocomplain abc list [catch {testparsevar {$abc}} msg] $msg } {1 {can't read "abc": no such variable}} test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar { unset -nocomplain abc list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg } {1 {invalid command name "bogus"}} test parse-13.6 {Tcl_ParseVar memory leak} -constraints {testparsevar memory} -setup { proc getbytes {} { return [lindex [split [memory info] \n] 3 3] } } -body { set a() foo set end [getbytes] for {set i 0} {$i < 5} {incr i} { |
︙ | ︙ | |||
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 |
︙ | ︙ | |||
980 981 982 983 984 985 986 | list [catch "subst \[" msg] $msg } [list 1 "missing close-bracket"] test parse-18.14 {Tcl_SubstObj, exception handling} { subst {abc,[break],def} } {abc,} test parse-18.15 {Tcl_SubstObj, exception handling} { | | | | | | | | 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 | list [catch "subst \[" msg] $msg } [list 1 "missing close-bracket"] test parse-18.14 {Tcl_SubstObj, exception handling} { subst {abc,[break],def} } {abc,} test parse-18.15 {Tcl_SubstObj, exception handling} { subst {abc,[continue; expr {1+2}],def} } {abc,,def} test parse-18.16 {Tcl_SubstObj, exception handling} { subst {abc,[return foo; expr {1+2}],def} } {abc,foo,def} test parse-18.17 {Tcl_SubstObj, exception handling} { subst {abc,[return -code 10 foo; expr {1+2}],def} } {abc,foo,def} test parse-18.18 {Tcl_SubstObj, exception handling} { subst {abc,[break; set {} {}{}],def} } {abc,} test parse-18.19 {Tcl_SubstObj, exception handling} { list [catch {subst {abc,[continue; expr {1+2}; set {} {}{}],def}} msg] $msg } [list 1 "extra characters after close-brace"] test parse-18.20 {Tcl_SubstObj, exception handling} { list [catch {subst {abc,[return foo; expr {1+2}; set {} {}{}],def}} msg] $msg } [list 1 "extra characters after close-brace"] test parse-18.21 {Tcl_SubstObj, exception handling} { list [catch { subst {abc,[return -code 10 foo; expr {1+2}; set {} {}{}],def} } msg] $msg } [list 1 "extra characters after close-brace"] test parse-18.22 {Tcl_SubstObj, side effects} { set a 0 list [subst {foo[incr a]bar}] $a } [list foo1bar 1] |
︙ | ︙ |
Changes to tests/parseExpr.test.
1 2 3 4 | # This file contains a collection of tests for the procedures in the # file tclCompExpr.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # This file contains a collection of tests for the procedures in the # file tclCompExpr.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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]] # Note that the Tcl expression parser (tclCompExpr.c) does not check # the semantic validity of the expressions it parses. It does not check, # for example, that a math function actually exists, or that the operands # of "<<" are integers. testConstraint testexprparser [llength [info commands testexprparser]] 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 } } } 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.
1 2 3 4 5 6 7 8 | # Commands covered: set (plus basic command syntax). Also tests the # procedures in the file tclOldParse.c. This set of tests is an old # one that predates the new parser in Tcl 8.1. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | # Commands covered: set (plus basic command syntax). Also tests the # procedures in the file tclOldParse.c. This set of tests is an old # one that predates the new parser in Tcl 8.1. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands 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 |
︙ | ︙ | |||
131 132 133 134 135 136 137 | format %s $b ]b set a } a22b test parseOld-4.4 {command substitution} { set a 7.7 | | | 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | format %s $b ]b set a } a22b test parseOld-4.4 {command substitution} { set a 7.7 if {[catch {expr {int($a)}}]} {set a foo} set a } 7.7 # Variable substitution. test parseOld-5.1 {variable substitution} { set a 123 |
︙ | ︙ | |||
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 |
︙ | ︙ | |||
451 452 453 454 455 456 457 | set a old eval " # set a new\\\\\nset a new" set a } {new} test parseOld-13.1 {comments at the end of a bracketed script} { set x "[ | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 | set a old eval " # set a new\\\\\nset a new" set a } {new} test parseOld-13.1 {comments at the end of a bracketed script} { set x "[ expr {1+1} # skip this! ]" } {2} test parseOld-15.1 {TclScriptEnd procedure} { info complete {puts [ expr {1+1} #this is a comment ]} } {0} test parseOld-15.2 {TclScriptEnd procedure} { info complete "abc\\\n" } {0} test parseOld-15.3 {TclScriptEnd procedure} { info complete "abc\\\\\n" |
︙ | ︙ |
Changes to tests/pid.test.
1 2 3 4 5 6 | # Commands covered: pid # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: pid # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1995 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/pkgMkIndex.test.
1 2 3 4 5 6 7 | # This file contains tests for the pkg_mkIndex command. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # This file contains tests for the pkg_mkIndex command. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1998-1999 Scriptics Corporation. # All rights reserved. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } |
︙ | ︙ | |||
311 312 313 314 315 316 317 | # This package is split into two files, to test packages that are split over # multiple files. package provide pkg2 1.0 namespace eval pkg2 { namespace export p2-1 } proc pkg2::p2-1 { num } { | | | | 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 | # This package is split into two files, to test packages that are split over # multiple files. package provide pkg2 1.0 namespace eval pkg2 { namespace export p2-1 } proc pkg2::p2-1 { num } { return [expr {$num * 2}] } } [file join pkg pkg2_a.tcl] makeFile { # This package is required by pkg1. # This package is split into two files, to test packages that are split over # multiple files. package provide pkg2 1.0 namespace eval pkg2 { namespace export p2-2 } proc pkg2::p2-2 { num } { return [expr {$num * 3}] } } [file join pkg pkg2_b.tcl] test pkgMkIndex-4.1 {split package} { pkgtest::runIndex -lazy $fullPkgPath pkg2_a.tcl pkg2_b.tcl } {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}} |
︙ | ︙ | |||
405 406 407 408 409 410 411 | makeFile { package provide pkg3 1.0 namespace eval pkg3 { namespace export p3-1 p3-2 } proc pkg3::p3-1 { num } { | | | | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 | makeFile { package provide pkg3 1.0 namespace eval pkg3 { namespace export p3-1 p3-2 } proc pkg3::p3-1 { num } { return {[expr {$num * 2}]} } proc pkg3::p3-2 { num } { return {[expr {$num * 3}]} } } [file join pkg pkg3.tcl] test pkgMkIndex-6.1 {pkg1 requires pkg3} { pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl } {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}} |
︙ | ︙ | |||
516 517 518 519 520 521 522 | # requires circ1 to give us a circularity. package require circ3 1.0 package provide circ2 1.0 namespace eval circ2 { namespace export c2-1 c2-2 } proc circ2::c2-1 { num } { | | | | 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 | # requires circ1 to give us a circularity. package require circ3 1.0 package provide circ2 1.0 namespace eval circ2 { namespace export c2-1 c2-2 } proc circ2::c2-1 { num } { return [expr {$num * [circ3::c3-1]}] } proc circ2::c2-2 { num } { return [expr {$num * [circ3::c3-2]}] } } [file join pkg circ2.tcl] makeFile { # This package is required by circ2, and in turn requires circ1. This closes # the circularity. package require circ1 1.0 |
︙ | ︙ | |||
555 556 557 558 559 560 561 | set x [file join [file dirname [info nameofexecutable]] dltest \ pkga[info sharedlibextension]] set dll "[file tail $x]Required" testConstraint $dll [file exists $x] if {[testConstraint $dll]} { makeFile { | | | | | 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 | set x [file join [file dirname [info nameofexecutable]] dltest \ pkga[info sharedlibextension]] set dll "[file tail $x]Required" testConstraint $dll [file exists $x] if {[testConstraint $dll]} { makeFile { # This package provides pkga, which is also provided by a DLL. package provide pkga 1.0 proc pkga_neq { x } { return [expr {! [pkgq_eq $x]}] } } [file join pkg pkga.tcl] file copy -force $x $fullPkgPath } testConstraint exec [llength [info commands ::exec]] test pkgMkIndex-10.1 {package in DLL and script} [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. 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 \ |
︙ | ︙ |
Changes to tests/platform.test.
1 2 3 4 5 6 | # The file tests the tcl_platform variable and platform package. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | # The file tests the tcl_platform variable and platform package. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1999 Scriptics Corporation # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.5 namespace eval ::tcl::test::platform { namespace import ::tcltest::testConstraint namespace import ::tcltest::test namespace import ::tcltest::cleanupTests # This is not how [variable] works. See TIP 276. #variable ::tcl_platform namespace upvar :: tcl_platform tcl_platform ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] package require tcltests testConstraint testCPUID [llength [info commands testcpuid]] testConstraint testlongsize [llength [info commands testlongsize]] test platform-1.0 {tcl_platform(engine)} { set tcl_platform(engine) |
︙ | ︙ |
Changes to tests/proc-old.test.
1 2 3 4 5 6 7 8 9 | # Commands covered: proc, return, global # # This file, proc-old.test, includes the original set of tests for Tcl's # proc, return, and global commands. There is now a new file proc.test # that contains tests for the tclProc.c source file. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | # Commands covered: proc, return, global # # This file, proc-old.test, includes the original set of tests for Tcl's # proc, return, and global commands. There is now a new file proc.test # that contains tests for the tclProc.c source file. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } catch {rename t1 ""} catch {rename foo ""} proc tproc {} {return a; return b} test proc-old-1.1 {simple procedure call and return} {tproc} a proc tproc x { set x [expr {$x + 1}] return $x } test proc-old-1.2 {simple procedure call and return} {tproc 2} 3 test proc-old-1.3 {simple procedure call and return} { proc tproc {} {return foo} } {} test proc-old-1.4 {simple procedure call and return} { |
︙ | ︙ | |||
45 46 47 48 49 50 51 | set x {} proc tproc {} {} ;# body is shared with x list [tproc] [append x foo] } {{} foo} test proc-old-2.1 {local and global variables} { proc tproc x { | | | | | | 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 | set x {} proc tproc {} {} ;# body is shared with x list [tproc] [append x foo] } {{} foo} test proc-old-2.1 {local and global variables} { proc tproc x { set x [expr {$x + 1}] return $x } set x 42 list [tproc 6] $x } {7 42} test proc-old-2.2 {local and global variables} { proc tproc x { set y [expr {$x + 1}] return $y } set y 18 list [tproc 6] $y } {7 18} test proc-old-2.3 {local and global variables} { proc tproc x { global y set y [expr {$x + 1}] return $y } set y 189 list [tproc 6] $y } {7 7} test proc-old-2.4 {local and global variables} { proc tproc x { global y return [expr {$x + $y}] } set y 189 list [tproc 6] $y } {195 189} catch {unset _undefined_} test proc-old-2.5 {local and global variables} { proc tproc x { |
︙ | ︙ | |||
500 501 502 503 504 505 506 | } 1 test proc-old-10.1 {ByteCode epoch change during recursive proc execution} { proc t1 x { set y 20 rename expr expr.old rename expr.old expr | | | 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 | } 1 test proc-old-10.1 {ByteCode epoch change during recursive proc execution} { proc t1 x { set y 20 rename expr expr.old rename expr.old expr if {$x} then {t1 0} ;# recursive call after foo's code is invalidated return 20 } t1 1 } 20 # cleanup catch {rename t1 ""} catch {rename foo ""} ::tcltest::cleanupTests return |
Changes to tests/proc.test.
1 2 3 4 5 6 7 8 9 | # This file contains tests for the tclProc.c source file. Tests appear in the # same order as the C code that they test. The set of tests is currently # incomplete since it includes only new tests, in particular tests for code # changed for the addition of Tcl namespaces. Other procedure-related tests # appear in other test files such as proc-old.test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # This file contains tests for the tclProc.c source file. Tests appear in the # same order as the C code that they test. The set of tests is currently # incomplete since it includes only new tests, in particular tests for code # changed for the addition of Tcl namespaces. Other procedure-related tests # appear in other test files such as proc-old.test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands 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 {} ""} catch {unset msg} |
︙ | ︙ | |||
96 97 98 99 100 101 102 | [namespace eval test_ns_1 {namespace which q:}] \ [namespace eval test_ns_1 {namespace which value:at:}] } -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:} test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup { catch {rename p ""} } -returnCodes error -body { proc p {a(1) a(2)} { | | | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | [namespace eval test_ns_1 {namespace which q:}] \ [namespace eval test_ns_1 {namespace which value:at:}] } -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:} test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup { catch {rename p ""} } -returnCodes error -body { proc p {a(1) a(2)} { set z [expr {$a(1)+$a(2)}] puts "$z=z, $a(1)=$a(1)" } } -result {formal parameter "a(1)" is an array element} test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup { catch {rename p ""} } -body { proc p {b:a b::a} { |
︙ | ︙ | |||
206 207 208 209 210 211 212 | catch {rename {a b c} {}} catch {unset msg} catch {rename p ""} catch {rename t ""} # Note that the test require that procedures whose body is used to create | | | | | | | | | | | | | | | | | | | | | 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 | catch {rename {a b c} {}} catch {unset msg} catch {rename p ""} catch {rename t ""} # Note that the test require that procedures whose body is used to create # procbody objects must be executed before the tcl::procbodytest::proc command is # executed, so that the Proc struct is populated correctly (CompiledLocals are # added at compile time). test proc-4.1 {TclCreateProc, procbody obj} -constraints tcl::test -body { proc p x {return "$x:$x"} set rv [p P] tcl::procbodytest::proc t x p lappend rv [t T] } -cleanup { catch {rename p ""} catch {rename t ""} } -result {P:P T:T} test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} -body { proc p x { set y [string tolower $x] return "$x:$y" } set rv [p P] tcl::procbodytest::proc t x p lappend rv [t T] } -constraints tcl::test -cleanup { catch {rename p ""} catch {rename t ""} } -result {P:p T:t} test proc-4.3 {TclCreateProc, procbody obj, too many args} -body { proc p x { set y [string tolower $x] return "$x:$y" } set rv [p P] tcl::procbodytest::proc t {x x1 x2} p lappend rv [t T] } -constraints tcl::test -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": arg list contains 3 entries, precompiled header expects 1} test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} -body { proc p {x y z} { set v [join [list $x $y $z]] set w [string tolower $v] return "$v:$w" } set rv [p P Q R] tcl::procbodytest::proc t {x x1 z} p lappend rv [t S T U] } -constraints tcl::test -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": formal parameter 1 is inconsistent with precompiled body} test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} -body { proc p {x y {z Z}} { set v [join [list $x $y $z]] set w [string tolower $v] return "$v:$w" } set rv [p P Q R] tcl::procbodytest::proc t {x y z} p lappend rv [t S T U] } -constraints tcl::test -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": formal parameter 2 is inconsistent with precompiled body} test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} -body { proc p {x y z} { set v [join [list $x $y $z]] set w [string tolower $v] return "$v:$w" } set rv [p P Q R] tcl::procbodytest::proc t {x y {z Z}} p lappend rv [t S T U] } -returnCodes error -constraints tcl::test -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": formal parameter 2 is inconsistent with precompiled body} test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} -body { proc p {x y {z Z}} { set v [join [list $x $y $z]] set w [string tolower $v] return "$v:$w" } set rv [p P Q R] tcl::procbodytest::proc t {x y {z ZZ}} p lappend rv [t S T U] } -constraints tcl::test -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} } -result {procedure "t": formal parameter "z" has default value inconsistent with precompiled body} test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex $lines 3 3 } proc px x { set y [string tolower $x] return "$x:$y" } px x } -constraints {tcl::test memory} -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { tcl::procbodytest::proc tx x px set tmp $end set end [getbytes] } set leakedBytes [expr {$end - $tmp}] } -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 |
︙ | ︙ |
Changes to tests/process.test.
1 2 3 4 5 6 | # process.test -- # # This file contains a collection of tests for the tcl::process ensemble. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # process.test -- # # This file contains a collection of tests for the tcl::process ensemble. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright © 2017 Frederic Bonnet # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } |
︙ | ︙ |
Changes to tests/pwd.test.
1 2 3 4 5 6 | # Commands covered: pwd # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | # Commands covered: pwd # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test pwd-1.1 {simple pwd} { catch pwd } 0 test pwd-1.2 {simple pwd} { expr {[string length [pwd]]>0} } 1 test pwd-2.1 {pwd takes no args} -body { pwd foobar } -returnCodes error -result "wrong \# args: should be \"pwd\"" # cleanup ::tcltest::cleanupTests return |
Changes to tests/reg.test.
1 2 3 4 5 6 7 8 9 | # reg.test -- # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # (Don't panic if you are seeing this as part of the reg distribution # and aren't using Tcl -- reg's own regression tester also knows how # to read this file, ignoring the Tcl-isms.) # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # reg.test -- # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # (Don't panic if you are seeing this as part of the reg distribution # and aren't using Tcl -- reg's own regression tester also knows how # to read this file, ignoring the Tcl-isms.) # # Copyright © 1998, 1999 Henry Spencer. All rights reserved. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] # All tests require the testregexp command, return if this # command doesn't exist ::tcltest::testConstraint testregexp [llength [info commands testregexp]] ::tcltest::testConstraint localeRegexp 0 |
︙ | ︙ | |||
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 |
︙ | ︙ | |||
1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 | # This is near the limits of the RE engine regexp [string repeat x*y*z* 480] x } 1 test reg-33.30 {Bug 1080042} { regexp {(\Y)+} foo } 1 # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: | > > > > | 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 | # This is near the limits of the RE engine regexp [string repeat x*y*z* 480] x } 1 test reg-33.30 {Bug 1080042} { regexp {(\Y)+} foo } 1 test reg-33.31 {Bug 7c64aa5e1a} { regexp -inline {(?b).\{1,10\}} {abcdef} } abcdef # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/regexp.test.
1 2 3 4 5 6 | # Commands covered: regexp, regsub # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: regexp, regsub # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1998 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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 |
︙ | ︙ |
Changes to tests/regexpComp.test.
1 2 3 4 5 6 | # Commands covered: regexp, regsub # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: regexp, regsub # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1998 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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 { | | | | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | } 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" | | | | 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 | 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 |
︙ | ︙ |
Changes to tests/registry.test.
1 2 3 4 5 6 7 8 9 | # registry.test -- # # This file contains a collection of tests for the registry command. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # In order for these tests to run, the registry package must be on the # auto_path or the registry package must have been loaded already. # | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | # registry.test -- # # This file contains a collection of tests for the registry command. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # In order for these tests to run, the registry package must be on the # auto_path or the registry package must have been loaded already. # # Copyright © 1997 Sun Microsystems, Inc. All rights reserved. # Copyright © 1998-1999 Scriptics Corporation. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands set ::regver [package require registry 1.3.6] }]} { testConstraint reg 1 } } testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] # determine the current locale testConstraint english [expr { [llength [info commands testlocale]] && [string match "English*" [testlocale all ""]] }] test registry-1.0 {check if we are testing the right dll} {win reg} { set ::regver } {1.3.6} test registry-1.1 {argument parsing for registry command} {win reg} { list [catch {registry} msg] $msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.1a {argument parsing for registry command} {win reg} { list [catch {registry -32bit} msg] $msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.1b {argument parsing for registry command} {win reg} { |
︙ | ︙ |
Changes to tests/remote.tcl.
1 2 3 4 5 6 | # This file contains Tcl code to implement a remote server that can be # used during testing of Tcl socket code. This server is used by some # of the tests in socket.test. # # Source this file in the remote server you are using to test Tcl against. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # This file contains Tcl code to implement a remote server that can be # used during testing of Tcl socket code. This server is used by some # of the tests in socket.test. # # Source this file in the remote server you are using to test Tcl against. # # Copyright © 1995-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # Initialize message delimitor # Initialize command array |
︙ | ︙ | |||
87 88 89 90 91 92 93 | if {[info exists env(serverPort)]} { set serverPort $env(serverPort) } } if {![info exists serverPort]} { for {set i 0} {$i < $argc} {incr i} { if {[string compare -port [lindex $argv $i]] == 0} { | | | | | | 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 | if {[info exists env(serverPort)]} { set serverPort $env(serverPort) } } if {![info exists serverPort]} { for {set i 0} {$i < $argc} {incr i} { if {[string compare -port [lindex $argv $i]] == 0} { if {$i < $argc - 1} { set serverPort [lindex $argv [expr {$i + 1}]] } break } } } if {![info exists serverPort]} { set serverPort 2048 } if {![info exists serverAddress]} { if {[info exists env(serverAddress)]} { set serverAddress $env(serverAddress) } } if {![info exists serverAddress]} { for {set i 0} {$i < $argc} {incr i} { if {[string compare -address [lindex $argv $i]] == 0} { if {$i < $argc - 1} { set serverAddress [lindex $argv [expr {$i + 1}]] } break } } } if {![info exists serverAddress]} { set serverAddress 0.0.0.0 |
︙ | ︙ |
Changes to tests/rename.test.
1 2 3 4 5 6 | # Commands covered: rename # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: rename # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testdel [llength [info commands testdel]] # Must eliminate the "unknown" command while the test is running, especially # if the test is being run in a program with its own special-purpose unknown # command. catch {rename unknown unknown.old} |
︙ | ︙ |
Changes to tests/resolver.test.
1 2 3 4 5 6 | # This test collection covers some unwanted interactions between command # literal sharing and the use of command resolvers (per-interp) which cause # command literals to be re-used with their command references being invalid # in the reusing context. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # This test collection covers some unwanted interactions between command # literal sharing and the use of command resolvers (per-interp) which cause # command literals to be re-used with their command references being invalid # in the reusing context. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 2011 Gustaf Neumann <[email protected]> # Copyright © 2011 Stefan Sobernig <[email protected]> # # 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 testinterpresolver [llength [info commands testinterpresolver]] test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup { testinterpresolver up namespace eval ::ns1 { proc z {} { return Z } |
︙ | ︙ |
Changes to tests/result.test.
1 2 3 4 5 6 | # This file tests the routines in tclResult.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # This file tests the routines in tclResult.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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]] # Some tests require the testsaveresult command testConstraint testsaveresult [llength [info commands testsaveresult]] testConstraint testsetobjerrorcode [llength [info commands testsetobjerrorcode]] testConstraint testseterrorcode [llength [info commands testseterrorcode]] testConstraint testreturn [llength [info commands testreturn]] |
︙ | ︙ |
Changes to tests/safe-stock.test.
︙ | ︙ | |||
18 19 20 21 22 23 24 | # - These are tests 7.1 7.2 7.4 9.11 9.13 # - Tests 7.[124], 9.1[13] use "package require opt". # - Tests 9.1[13] also use "package require tcl::idna". # - The corresponding tests in safe.test use example packages provided in # subdirectory auto0 of the tests directory, which are independent of any # changes made to the packages provided with Tcl. # | | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # - These are tests 7.1 7.2 7.4 9.11 9.13 # - Tests 7.[124], 9.1[13] use "package require opt". # - Tests 9.1[13] also use "package require tcl::idna". # - The corresponding tests in safe.test use example packages provided in # subdirectory auto0 of the tests directory, which are independent of any # changes made to the packages provided with Tcl. # # Copyright © 1995-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Added tests/safe-stock86.test.
Changes to tests/safe-zipfs.test.
1 2 3 4 5 6 7 8 9 | # safe-zipfs.test -- # # This file contains tests for safe Tcl that test its compatibility with the # zipfs facilities introduced in Tcl 8.7. Test numbering is for comparison # with similar tests in safe.test that do not use the zipfs file system. # # Sourcing this file into tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | < > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 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 | # safe-zipfs.test -- # # This file contains tests for safe Tcl that test its compatibility with the # zipfs facilities introduced in Tcl 8.7. Test numbering is for comparison # with similar tests in safe.test that do not use the zipfs file system. # # Sourcing this file into tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1995-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. apply [list {} { global auto_path global tcl_library if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 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.
︙ | ︙ | |||
10 11 12 13 14 15 16 | # of any changes made to the packages provided with Tcl itself. # - These are tests 7.1 7.2 7.4 9.11 9.13 # - Tests 5.* test the example packages themselves before they # are used to test Safe Base interpreters. # - Alternative tests using stock packages of Tcl 8.7 are in file # safe-stock.test. # | | | > > | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | # of any changes made to the packages provided with Tcl itself. # - These are tests 7.1 7.2 7.4 9.11 9.13 # - Tests 5.* test the example packages themselves before they # are used to test Safe Base interpreters. # - Alternative tests using stock packages of Tcl 8.7 are in file # safe-stock.test. # # Copyright © 1995-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] foreach i [interp children] { interp delete $i } set SaveAutoPath $::auto_path set ::auto_path [info library] |
︙ | ︙ | |||
50 51 52 53 54 55 56 | } # 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} # testing that nested and statics do what is advertised (we use a static | | | | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | } # 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} # testing that nested and statics do what is advertised (we use a static # package - tcl::test - but it might be absent if we're in standard tclsh) testConstraint tcl::test [expr {![catch {package require tcl::test}]}] test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body { safe::interpConfigure } -result {no value given for parameter "child" (use -help for full usage) : child name () name of the child} test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body { safe::interpCreate -help |
︙ | ︙ | |||
168 169 170 171 172 173 174 175 176 177 178 179 180 181 | safe::interpCreate a a eval exit } -result "" # The old test "safe-5.1" has been moved to "safe-stock-9.8". # A replacement test using example files is "safe-9.8". # Tests 5.* test the example files before using them to test safe interpreters. test safe-5.1 {example tclIndex commands, test in parent interpreter} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2] } -body { # Try to load the commands. set code3 [catch report1 msg3] | > > | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 | safe::interpCreate a a eval exit } -result "" # The old test "safe-5.1" has been moved to "safe-stock-9.8". # A replacement test using example files is "safe-9.8". # Tests 5.* test the example files before using them to test safe interpreters. unset -nocomplain path test safe-5.1 {example tclIndex commands, test in parent interpreter} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2] } -body { # Try to load the commands. set code3 [catch report1 msg3] |
︙ | ︙ | |||
1153 1154 1155 1156 1157 1158 1159 | {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 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 | {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} test safe-10.1.1 {testing statics loading} -constraints tcl::test -setup { set i [safe::interpCreate] } -body { catch {interp eval $i {load {} Safepfx1}} m o dict get $o -errorinfo } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure invoked from within "load {} Safepfx1" invoked from within "interp eval $i {load {} Safepfx1}"} test safe-10.2 {testing statics loading / -nostatics} -constraints tcl::test -body { set i [safe::interpCreate -nostatics] interp eval $i {load {} Safepfx1} } -returnCodes error -cleanup { safe::interpDelete $i } -result {permission denied (static library)} test safe-10.3 {testing nested statics loading / no nested by default} -setup { set i [safe::interpCreate] } -constraints tcl::test -body { interp eval $i {interp create x; load {} Safepfx1 x} } -returnCodes error -cleanup { safe::interpDelete $i } -result {permission denied (nested load)} test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body { set i [safe::interpCreate -nestedloadok] interp eval $i {interp create x; load {} Safepfx1 x} } -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} test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body { set i [safe::interpCreate -nestedloadok] catch {interp eval $i {interp create x; load {} Safepfx1 x}} m o dict get $o -errorinfo } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure invoked from within "load {} Safepfx1 x" invoked from within "interp eval $i {interp create x; load {} Safepfx1 x}"} test safe-11.1 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding } -returnCodes error -cleanup { safe::interpDelete $i |
︙ | ︙ | |||
1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 | safe::interpDelete $i unset user } -result {~USER} # cleanup set ::auto_path $SaveAutoPath unset SaveAutoPath TestsDir PathMapp rename mapList {} rename mapAndSortList {} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: | > | 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 | safe::interpDelete $i unset user } -result {~USER} # cleanup set ::auto_path $SaveAutoPath unset SaveAutoPath TestsDir PathMapp unset -nocomplain path rename mapList {} rename mapAndSortList {} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/scan.test.
1 2 3 4 5 6 | # Commands covered: scan # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: scan # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1994 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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/security.test.
1 2 3 4 5 6 7 8 | # security.test -- # # Functionality covered: this file contains a collection of tests for the auto # loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # security.test -- # # Functionality covered: this file contains a collection of tests for the auto # loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # All rights reserved. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } |
︙ | ︙ |
Changes to tests/set-old.test.
1 2 3 4 5 6 7 8 | # Commands covered: set, unset, array # # This file includes the original set of tests for Tcl's set command. # Since the set command is now compiled, a new set of tests covering # the new implementation is in the file "set.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # Commands covered: set, unset, array # # This file includes the original set of tests for Tcl's set command. # Since the set command is now compiled, a new set of tests covering # the new implementation is in the file "set.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/set.test.
1 2 3 4 5 6 | # Commands covered: set # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # Commands covered: set # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testset2 [llength [info commands testset2]] catch {unset x} catch {unset i} test set-1.1 {TclCompileSetCmd: missing variable name} { |
︙ | ︙ |
Changes to tests/socket.test.
1 2 3 4 5 6 | # Commands tested in this file: socket. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # Commands tested in this file: socket. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # Running socket tests with a remote server: # ------------------------------------------ # |
︙ | ︙ | |||
62 63 64 65 66 67 68 | if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands | | > > | | | > > | 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 | 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]] ::tcltest::loadTestedCommands # A bad interaction between socket creation, macOS, and unattended CI # environments make this whole file impractical to run; too many weird hangs. if {[info exists ::env(MAC_CI)]} { 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 knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}] 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): set port 0x7fffffff catch { |
︙ | ︙ | |||
291 292 293 294 295 296 297 298 299 300 301 302 303 304 | proc getPort sock { lindex [fconfigure $sock -sockname] 2 } # Some tests in this file are known to hang *occasionally* on OSX; stop the # worst offenders. testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] # ---------------------------------------------------------------------- test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server } -returnCodes error -result {no argument given for -server option} test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body { | > > | 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 | proc getPort sock { lindex [fconfigure $sock -sockname] 2 } # Some tests in this file are known to hang *occasionally* on OSX; stop the # worst offenders. testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] # Here "Windows" means derived platforms as Cygwin or Msys2 too. testConstraint notWindows [expr {![regexp {^(Windows|MSYS|CYGWIN)} $::tcl_platform(os)]}] # ---------------------------------------------------------------------- test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server } -returnCodes error -result {no argument given for -server option} test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body { |
︙ | ︙ | |||
933 934 935 936 937 938 939 | test socket_$af-5.1 {byte order problems, socket numbers, htons} -body { if {![catch {socket -server dodo 0x1} msg]} { close $msg return {htons problem, should be disallowed, are you running as SU?} } return {couldn't open socket: not owner} | | | | | 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 | test socket_$af-5.1 {byte order problems, socket numbers, htons} -body { if {![catch {socket -server dodo 0x1} msg]} { close $msg return {htons problem, should be disallowed, are you running as SU?} } return {couldn't open socket: not owner} } -constraints [list socket supported_$af unix notRoot notOSX notWindows] -result {couldn't open socket: not owner} test socket_$af-5.2 {byte order problems, socket numbers, htons} -body { if {![catch {socket -server dodo 0x10000} msg]} { close $msg return {port resolution problem, should be disallowed} } return {couldn't open socket: port number too high} } -constraints [list socket supported_$af] -result {couldn't open socket: port number too high} test socket_$af-5.3 {byte order problems, socket numbers, htons} -body { if {![catch {socket -server dodo 21} msg]} { close $msg return {htons problem, should be disallowed, are you running as SU?} } return {couldn't open socket: not owner} } -constraints [list socket supported_$af unix notRoot notOSX notWindows] -result {couldn't open socket: not owner} test socket_$af-6.1 {accept callback error} -constraints [list socket supported_$af stdio] -setup { proc myHandler {msg options} { variable x $msg } set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] file delete $path(script) } -body { set f [open $path(script) w] puts $f [list set localhost $localhost] puts $f { gets stdin port socket $localhost $port } close $f set f [open "|[list [interpreter] $path(script)]" r+] proc accept {s a p} {expr {10 / 0}} set s [socket -server accept -myaddr $localhost 0] puts $f [lindex [fconfigure $s -sockname] 2] close $f set timer [after 10000 "set x timed_out"] vwait x after cancel $timer close $s |
︙ | ︙ | |||
1863 1864 1865 1866 1867 1868 1869 | set port [randport] set srvsock [socket -server {apply {{ch args} {close $ch}}} -myaddr $::localhost $port] # socket on windows has some issues yet (e. g. bug [b6d0d8cc2c]), so we simply decrease iteration count (to 1/4): if {$::tcl_platform(platform) eq "windows" && $maxIter > 50} { set ::count [expr {$maxIter / 4 * 3 - 1}]; # bypass 3/4 iterations } } | | | 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 | set port [randport] set srvsock [socket -server {apply {{ch args} {close $ch}}} -myaddr $::localhost $port] # socket on windows has some issues yet (e. g. bug [b6d0d8cc2c]), so we simply decrease iteration count (to 1/4): if {$::tcl_platform(platform) eq "windows" && $maxIter > 50} { set ::count [expr {$maxIter / 4 * 3 - 1}]; # bypass 3/4 iterations } } tcltest::DebugPuts 2 "== test \[$::localhost\]:$port $testmode ==" set ::parent [thread::id] # helper thread creating async connection and initiating transfer (detach) to parent: set ::helper [thread::create] thread::send -async $::helper [list \ lassign [list $::parent $::localhost $port $testmode] \ ::parent ::localhost ::port ::testmode ] |
︙ | ︙ | |||
1891 1892 1893 1894 1895 1896 1897 | thread::detach $fd thread::send -async $::parent [list transf_parent $fd {*}$args] } iteration first } # parent proc commiting transfer attempt (attach) and checking acquire was successful: proc transf_parent {fd args} { | | | 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 | thread::detach $fd thread::send -async $::parent [list transf_parent $fd {*}$args] } iteration first } # parent proc commiting transfer attempt (attach) and checking acquire was successful: proc transf_parent {fd args} { tcltest::DebugPuts 2 "** trma / $::count ** $args **" thread::attach $fd if {"parent-close" in $::testmode} {;# to test close during connect set ::count $::count close $fd return };# fileevent $fd writable [list apply {{fd} { |
︙ | ︙ | |||
1918 1919 1920 1921 1922 1923 1924 | vwait ::count if {![string is integer $::count]} { # if timeout just skip (test was successful until now): if {$::count eq "TIMEOUT"} {::tcltest::Skip "timing issue"} break } if {[incr ::count] >= $maxIter} break | | | | 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 | vwait ::count if {![string is integer $::count]} { # if timeout just skip (test was successful until now): if {$::count eq "TIMEOUT"} {::tcltest::Skip "timing issue"} break } if {[incr ::count] >= $maxIter} break tcltest::DebugPuts 2 "** iter / $::count **" thread::send -async $::helper [list iteration nr $::count] } update set ::count } finally { catch {after cancel $tout} if {$srvsock ne {}} {close $srvsock} if {[info exists ::helper]} {thread::release -wait $::helper} tcltest::DebugPuts 2 "== stop / $::count ==" unset -nocomplain ::count ::testmode ::parent ::helper } } test socket_$af-13.2.tr1 {Testing socket transfer between threads during async connect} -body { transf_test {transfer} 1000 } -result 1000 -constraints [list socket supported_$af thread] test socket_$af-13.2.tr2 {Testing socket transfer between threads during async connect} -body { |
︙ | ︙ | |||
2386 2387 2388 2389 2390 2391 2392 | list [fconfigure $sock -error] [gets $fd] } -cleanup { close $fd close $sock removeFile script } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \ | | | 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 | list [fconfigure $sock -error] [gets $fd] } -cleanup { close $fd close $sock removeFile script } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \ -constraints {socket notWinCI} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 puts $sock ok fileevent $sock writable {set x 1} vwait x close $sock |
︙ | ︙ |
Changes to tests/source.test.
1 2 3 4 5 6 | # Commands covered: source # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: source # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-2000 Scriptics Corporation. # Contributions from Don Porter, NIST, 2003. (not subject to US copyright) # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[catch {package require tcltest 2.5}]} { puts stderr "Skipping tests in [info script]. tcltest 2.5 required." |
︙ | ︙ | |||
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 $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 $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 $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.
1 2 3 4 5 6 | # Commands covered: split # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: split # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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/stack.test.
1 2 3 4 5 6 | # Tests that the stack size is big enough for the application. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # Tests that the stack size is big enough for the application. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/string.test.
1 2 3 4 5 6 | # Commands covered: string # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | # Commands covered: string # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2001 Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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} |
︙ | ︙ | |||
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} { | | | | | | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | 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} { | | | | | 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 | 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} { | | | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 | 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} { | | | | | | | | | | 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 | 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} { | | | | | | | | 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 | 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} { | | | | | | 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 | 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 |
︙ | ︙ | |||
507 508 509 510 511 512 513 | run {string index [binary format I* {0x50515253 0x52}] 20} } -result {} test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints fullutf -body { run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]} } -result [list \U100000 b {}] | < < < < < < < < < | 507 508 509 510 511 512 513 514 515 516 517 518 519 520 | run {string index [binary format I* {0x50515253 0x52}] 20} } -result {} test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints fullutf -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} { |
︙ | ︙ | |||
556 557 558 559 560 561 562 | } 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} | | | | 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 | } 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} |
︙ | ︙ | |||
588 589 590 591 592 593 594 | 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} { | | | | 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 | 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 test string-6.28.$noComp {string is double, true} { run {string is double [expr {double(1)}]} } 1 test string-6.29.$noComp {string is double, true} { run {string is double 1.0} } 1 test string-6.30.$noComp {string is double, true} { run {string is double [run {string compare a a}]} } 1 |
︙ | ︙ | |||
630 631 632 633 634 635 636 | test string-6.37.$noComp {string is double, false on int overflow} -setup { set var priorValue } -body { # Make it the largest int recognizable, with one more digit for overflow # Since bignums arrived in Tcl 8.5, the sense of this test changed. # Now integer values that exceed native limits become bignums, and # bignums can convert to doubles without error. | | | 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | test string-6.37.$noComp {string is double, false on int overflow} -setup { set var priorValue } -body { # Make it the largest int recognizable, with one more digit for overflow # Since bignums arrived in Tcl 8.5, the sense of this test changed. # Now integer values that exceed native limits become bignums, and # bignums can convert to doubles without error. list [run {string is double -fail var 9223372036854775808}] $var } -result {1 priorValue} # string-6.38 removed, underflow on input is no longer an error. test string-6.39.$noComp {string is double, false} { # This test is non-portable because IRIX thinks # that .e1 is a valid double - this is really a bug # on IRIX as .e1 should NOT be a valid double # |
︙ | ︙ | |||
672 673 674 675 676 677 678 | catch {unset var} list [run {string is false -fail var offensive}] $var } {0 0} test string-6.48.$noComp {string is integer, true} { run {string is integer +1234567890} } 1 test string-6.49.$noComp {string is integer, true on type} { | | | | | | | 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 | catch {unset var} list [run {string is false -fail var offensive}] $var } {0 0} test string-6.48.$noComp {string is integer, true} { run {string is integer +1234567890} } 1 test string-6.49.$noComp {string is integer, true on type} { run {string is integer [expr {int(50.0)}]} } 1 test string-6.50.$noComp {string is integer, true} { run {string is integer [list -10]} } 1 test string-6.51.$noComp {string is integer, true as hex} { run {string is integer 0xabcdef} } 1 test string-6.52.$noComp {string is integer, true as octal} { run {string is integer 012345} } 1 test string-6.53.$noComp {string is integer, true with whitespace} { run {string is integer " \n1234\v"} } 1 test string-6.54.$noComp {string is integer, false} { list [run {string is integer -fail var 123abc}] $var } {0 3} test string-6.55.$noComp {string is integer, no overflow possible} { run {string is integer +9223372036854775808} } 1 test string-6.56.$noComp {string is integer, false} { list [run {string is integer -fail var [expr {double(1)}]}] $var } {0 1} test string-6.57.$noComp {string is integer, false} { list [run {string is integer -fail var " "}] $var } {0 0} test string-6.58.$noComp {string is integer, false on bad octal} { list [run {string is integer -fail var 0o36963}] $var } {0 4} test string-6.58.1.$noComp {string is integer, false on bad octal} { list [run {string is integer -fail var 0o36963}] $var } {0 4} 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} |
︙ | ︙ | |||
758 759 760 761 762 763 764 | 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} { | | | | | 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 | 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} |
︙ | ︙ | |||
842 843 844 845 846 847 848 | set x 0x10000000000000000 run {string is integer [expr {$x}]} } 1 test string-6.95.$noComp {string is wideinteger, true} { run {string is wideinteger +1234567890} } 1 test string-6.96.$noComp {string is wideinteger, true on type} { | | | | | 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 | set x 0x10000000000000000 run {string is integer [expr {$x}]} } 1 test string-6.95.$noComp {string is wideinteger, true} { run {string is wideinteger +1234567890} } 1 test string-6.96.$noComp {string is wideinteger, true on type} { run {string is wideinteger [expr {wide(50.0)}]} } 1 test string-6.97.$noComp {string is wideinteger, true} { run {string is wideinteger [list -10]} } 1 test string-6.98.$noComp {string is wideinteger, true as hex} { run {string is wideinteger 0xabcdef} } 1 test string-6.99.$noComp {string is wideinteger, true as octal} { run {string is wideinteger 0123456} } 1 test string-6.100.$noComp {string is wideinteger, true with whitespace} { run {string is wideinteger " \n1234\v"} } 1 test string-6.101.$noComp {string is wideinteger, false} { list [run {string is wideinteger -fail var 123abc}] $var } {0 3} test string-6.102.$noComp {string is wideinteger, false on overflow} { list [run {string is wideinteger -fail var +9223372036854775808}] $var } {0 -1} test string-6.103.$noComp {string is wideinteger, false} { list [run {string is wideinteger -fail var [expr {double(1)}]}] $var } {0 1} test string-6.104.$noComp {string is wideinteger, false} { list [run {string is wideinteger -fail var " "}] $var } {0 0} test string-6.105.$noComp {string is wideinteger, false on bad octal} { list [run {string is wideinteger -fail var 0o36963}] $var } {0 4} |
︙ | ︙ | |||
898 899 900 901 902 903 904 | test string-6.109.$noComp {string is double, Bug 1360532} { run {string is double 1\xA0} } 0 test string-6.110.$noComp {string is entier, true} { run {string is entier +1234567890} } 1 test string-6.111.$noComp {string is entier, true on type} { | | | | 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 | test string-6.109.$noComp {string is double, Bug 1360532} { run {string is double 1\xA0} } 0 test string-6.110.$noComp {string is entier, true} { run {string is entier +1234567890} } 1 test string-6.111.$noComp {string is entier, true on type} { run {string is entier [expr {wide(50.0)}]} } 1 test string-6.112.$noComp {string is entier, true} { run {string is entier [list -10]} } 1 test string-6.113.$noComp {string is entier, true as hex} { run {string is entier 0xabcdef} } 1 test string-6.114.$noComp {string is entier, true as octal} { run {string is entier 0123456} } 1 test string-6.115.$noComp {string is entier, true with whitespace} { run {string is entier " \n1234\v"} } 1 test string-6.116.$noComp {string is entier, false} { list [run {string is entier -fail var 123abc}] $var } {0 3} test string-6.117.$noComp {string is entier, false} { list [run {string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc}] $var } {0 84} test string-6.118.$noComp {string is entier, false} { list [run {string is entier -fail var [expr {double(1)}]}] $var } {0 1} test string-6.119.$noComp {string is entier, false} { list [run {string is entier -fail var " "}] $var } {0 0} test string-6.120.$noComp {string is entier, false on bad octal} { list [run {string is entier -fail var 0o36963}] $var } {0 4} |
︙ | ︙ | |||
967 968 969 970 971 972 973 | 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} | < < | | | | | | | | | 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 | 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} { 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} { list [catch {run {string bytelength}} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} test string-8.2.$noComp {string bytelength} { list [catch {run {string bytelength a b}} msg] $msg |
︙ | ︙ | |||
1046 1047 1048 1049 1050 1051 1052 | 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} { | | | 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 | 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 |
︙ | ︙ | |||
1089 1090 1091 1092 1093 1094 1095 | 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} { | | | | | | 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 | 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} { |
︙ | ︙ | |||
1297 1298 1299 1300 1301 1302 1303 | 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} { | | | 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 | 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]} _} |
︙ | ︙ | |||
1464 1465 1466 1467 1468 1469 1470 | 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} { | | | | | 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 | 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} { |
︙ | ︙ | |||
1551 1552 1553 1554 1555 1556 1557 | 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} { | | | | | | 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 | 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?"}} |
︙ | ︙ | |||
1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 | 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]]] | > > > > > > > > > > > > | 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 | 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]]] |
︙ | ︙ | |||
1853 1854 1855 1856 1857 1858 1859 | 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]}]] | | | 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 | 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 |
︙ | ︙ | |||
1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 | } -result 6 test string-21.15.$noComp {string wordend, unicode} -body { run {string wordend "\U1D7CA\U1D7CA abc" 0} } -result 2 test string-21.16.$noComp {string wordend, unicode} -constraints fullutf -body { run {string wordend "\U1D7CA\U1D7CA abc" 10} } -result 6 test string-22.1.$noComp {string wordstart} -body { list [catch {run {string word a}} msg] $msg } -result {1 {unknown or ambiguous subcommand "word": must be bytelength, 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"}} | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | } -result 6 test string-21.15.$noComp {string wordend, unicode} -body { run {string wordend "\U1D7CA\U1D7CA abc" 0} } -result 2 test string-21.16.$noComp {string wordend, unicode} -constraints fullutf -body { run {string wordend "\U1D7CA\U1D7CA abc" 10} } -result 6 test string-21.17.$noComp {string trim, unicode} { run {string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} } "Hello world!" test string-21.18.$noComp {string trimleft, unicode} { run {string trimleft "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} } "Hello world!\uD83D\uDE02" test string-21.19.$noComp {string trimright, unicode} { run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} } "\uD83D\uDE02Hello world!" test string-21.20.$noComp {string trim, unicode} { run {string trim "\uF602Hello world!\uF602" \uD83D\uDE02} } "\uF602Hello world!\uF602" test string-21.21.$noComp {string trimleft, unicode} { run {string trimleft "\uF602Hello world!\uF602" \uD83D\uDE02} } "\uF602Hello world!\uF602" test string-21.22.$noComp {string trimright, unicode} { run {string trimright "\uF602Hello world!\uF602" \uD83D\uDE02} } "\uF602Hello world!\uF602" test string-21.23.$noComp {string trim, unicode} { run {string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} } "\uD83D\uDE02Hello world!\uD83D\uDE02" test string-21.24.$noComp {string trimleft, unicode} { run {string trimleft "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} } "\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 } -result {1 {unknown or ambiguous subcommand "word": must be bytelength, 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"}} |
︙ | ︙ | |||
2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 | binary scan [run {string reverse [binary format H* 010203]}] H* x set x } 030201 test string-24.15.$noComp {string reverse command - pure bytearray} { binary scan [run {tcl::string::reverse [binary format H* 010203]}] H* x set x } 030201 test string-25.1.$noComp {string is list} { run {string is list {a b c}} } 1 test string-25.2.$noComp {string is list} { run {string is list "a \{b c"} } 0 | > > > > > > > > > > > > > > > > > > | 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 | binary scan [run {string reverse [binary format H* 010203]}] H* x set x } 030201 test string-24.15.$noComp {string reverse command - pure bytearray} { binary scan [run {tcl::string::reverse [binary format H* 010203]}] H* x set x } 030201 test string-24.16.$noComp {string reverse command - surrogates} { run {string reverse \u0444bulb\uD83D\uDE02} } \uD83D\uDE02blub\u0444 test string-24.17.$noComp {string reverse command - surrogates} { run {string reverse \uD83D\uDE02hello\uD83D\uDE02} } \uD83D\uDE02olleh\uD83D\uDE02 test string-24.18.$noComp {string reverse command - surrogates} { set s \u0444bulb\uD83D\uDE02 # shim shimmery ... string index $s 0 run {string reverse $s} } \uD83D\uDE02blub\u0444 test string-24.19.$noComp {string reverse command - surrogates} { set s \uD83D\uDE02hello\uD83D\uDE02 # shim shimmery ... string index $s 0 run {string reverse $s} } \uD83D\uDE02olleh\uD83D\uDE02 test string-25.1.$noComp {string is list} { run {string is list {a b c}} } 1 test string-25.2.$noComp {string is list} { run {string is list "a \{b c"} } 0 |
︙ | ︙ |
Changes to tests/stringObj.test.
1 2 3 4 5 6 7 8 | # Commands covered: none # # This file contains tests for the procedures in tclStringObj.c that implement # the Tcl type manager for the string type. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | # Commands covered: none # # This file contains tests for the procedures in tclStringObj.c that implement # the Tcl type manager for the string type. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1995-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands 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 fullutf [expr {[string length \U010000] == 1}] test stringObj-1.1 {string type registration} testobj { |
︙ | ︙ | |||
203 204 205 206 207 208 209 | 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 { | | | | | | | | | | | | | | | | | | | | | < < < < < | | | < < < | | < < < | | | | | 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 | 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} |
︙ | ︙ | |||
389 390 391 392 393 394 395 | 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 { | | | | | | | | | | | 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 | 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} { |
︙ | ︙ |
Changes to tests/subst.test.
1 2 3 4 5 6 | # Commands covered: subst # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # Commands covered: subst # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1994 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testbytestring [llength [info commands testbytestring]] test subst-1.1 {basics} -returnCodes error -body { subst } -result {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"} test subst-1.2 {basics} -returnCodes error -body { |
︙ | ︙ | |||
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 |
︙ | ︙ | |||
128 129 130 131 132 133 134 | subst -no bar } -result {ambiguous option "-no": must be -nobackslashes, -nocommands, or -novariables} test subst-7.3 {switches} -returnCodes error -body { subst -bogus bar } -result {bad option "-bogus": must be -nobackslashes, -nocommands, or -novariables} test subst-7.4 {switches} { set x 123 | | | | | | | | 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 | subst -no bar } -result {ambiguous option "-no": must be -nobackslashes, -nocommands, or -novariables} test subst-7.3 {switches} -returnCodes error -body { subst -bogus bar } -result {bad option "-bogus": must be -nobackslashes, -nocommands, or -novariables} test subst-7.4 {switches} { set x 123 subst -nobackslashes {abc $x [expr {1 + 2}] \\\x41} } {abc 123 3 \\\x41} test subst-7.5 {switches} { set x 123 subst -nocommands {abc $x [expr {1 + 2}] \\\x41} } {abc 123 [expr {1 + 2}] \A} test subst-7.6 {switches} { set x 123 subst -novariables {abc $x [expr {1 + 2}] \\\x41} } {abc $x 3 \A} test subst-7.7 {switches} { set x 123 subst -nov -nob -noc {abc $x [expr {1 + 2}] \\\x41} } {abc $x [expr {1 + 2}] \\\x41} test subst-8.1 {return in a subst} { subst {foo [return {x}; bogus code] bar} } {foo x bar} test subst-8.2 {return in a subst} { subst {foo [return x ; bogus code] bar} } {foo x bar} |
︙ | ︙ |
Changes to tests/switch.test.
1 2 3 4 5 6 | # Commands covered: switch # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: switch # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/tailcall.test.
1 2 3 4 5 6 | # Commands covered: tailcall # # This file contains a collection of tests for experimental commands that are # found in ::tcl::unsupported. The tests will migrate to normal test files # if/when the commands find their way into the core. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # Commands covered: tailcall # # This file contains a collection of tests for experimental commands that are # found in ::tcl::unsupported. The tests will migrate to normal test files # if/when the commands find their way into the core. # # Copyright © 2008 Miguel Sofer. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testnrelevels [llength [info commands testnrelevels]] # # The tests that risked blowing the C stack on failure have been removed: we # can now actually measure using testnrelevels. # |
︙ | ︙ |
Changes to tests/tcltest.test.
1 2 3 4 | # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2000 Ajuba Solutions # All rights reserved. # Note that there are several places where the value of # tcltest::currentFailure is stored/reset in the -setup/-cleanup # of a test that has a body that runs [test] that will fail. # This is a workaround of using the same tcltest code that we are # testing to run the test itself. Ditto on things like [verbose]. |
︙ | ︙ | |||
543 544 545 546 547 548 549 | set notReadableDir [file join [temporaryDirectory] notreadable] set notWriteableDir [file join [temporaryDirectory] notwriteable] makeDirectory notreadable makeDirectory notwriteable switch -- $::tcl_platform(platform) { unix { | | | | 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 | set notReadableDir [file join [temporaryDirectory] notreadable] set notWriteableDir [file join [temporaryDirectory] notwriteable] makeDirectory notreadable makeDirectory notwriteable switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 0o333 file attributes $notWriteableDir -permissions 0o555 } default { # note in FAT/NTFS we won't be able to protect directory with read-only attribute... catch {file attributes $notWriteableDir -readonly 1} catch {testchmod 0 $notWriteableDir} } } |
︙ | ︙ | |||
1441 1442 1443 1444 1445 1446 1447 | } test tcltest-23.2 {removeFile} { -setup { set mfdir [file join [temporaryDirectory] mfdir] file mkdir $mfdir makeFile {} t1.tmp makeFile {} et1.tmp $mfdir | | | 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 | } test tcltest-23.2 {removeFile} { -setup { set mfdir [file join [temporaryDirectory] mfdir] file mkdir $mfdir makeFile {} t1.tmp makeFile {} et1.tmp $mfdir if {![file exists [file join [temporaryDirectory] t1.tmp]] || \ ![file exists [file join $mfdir et1.tmp]]} { error "file creation didn't work" } } -body { removeFile t1.tmp removeFile et1.tmp $mfdir |
︙ | ︙ |
Changes to tests/tcltests.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 | #! /usr/bin/env tclsh package require tcltest 2.5 namespace import ::tcltest::* testConstraint exec [llength [info commands exec]] testConstraint fcopy [llength [info commands fcopy]] testConstraint fileevent [llength [info commands fileevent]] testConstraint thread [ expr {0 == [catch {package require Thread 2.7-}]}] testConstraint notValgrind [expr {![testConstraint valgrind]}] | > > > > > > > > > > > > | 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]] if {[namespace which testdebug] ne {}} { testConstraint debug [testdebug] testConstraint purify [testpurify] testConstraint debugpurify [ expr { ![testConstraint memory] && [testConstraint debug] && [testConstraint purify] }] } testConstraint fcopy [llength [info commands fcopy]] testConstraint fileevent [llength [info commands fileevent]] testConstraint thread [ expr {0 == [catch {package require Thread 2.7-}]}] testConstraint notValgrind [expr {![testConstraint valgrind]}] |
︙ | ︙ |
Changes to tests/thread.test.
1 2 3 4 5 6 | # Commands covered: (test)thread # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # Commands covered: (test)thread # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2006-2008 Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # when thread::release is used, -wait is passed in order allow the thread to # be fully finalized, which avoids valgrind "still reachable" reports. ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] package require tcltests # Some tests require the testthread command testConstraint testthread [expr {[info commands testthread] ne {}}] |
︙ | ︙ |
Changes to tests/timer.test.
1 2 3 4 5 6 7 8 9 | # This file contains a collection of tests for the procedures in the # file tclTimer.c, which includes the "after" Tcl command. Sourcing # this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # This file contains a collection of tests for the procedures in the # file tclTimer.c, which includes the "after" Tcl command. Sourcing # this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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/tm.test.
1 2 3 4 5 | # This file contains tests for the ::tcl::tm::* commands. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | # This file contains tests for the ::tcl::tm::* commands. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright © 2004 Donal K. Fellows. # All rights reserved. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } |
︙ | ︙ | |||
195 196 197 198 199 200 201 | ::tcl::tm::path list } -result {geode snarf foo} proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] | | | 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | ::tcl::tm::path list } -result {geode snarf foo} proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor set results {} set base [file join $base tcl$major] lappend results [file join $base site-tcl] for {set i 0} {$i <= $minor} {incr i} { lappend results [file join $base ${major}.$i] } return $results |
︙ | ︙ |
Changes to tests/trace.test.
1 2 3 4 5 6 | # Commands covered: trace # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: trace # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testcmdtrace [llength [info commands testcmdtrace]] testConstraint testevalobjv [llength [info commands testevalobjv]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] |
︙ | ︙ | |||
2310 2311 2312 2313 2314 2315 2316 | } {1 {unknown command "thisdoesntexist"}} test trace-28.10 {exec trace info nonsense} { list [catch {trace remove execution} res] $res } {1 {wrong # args: should be "trace remove execution name opList command"}} test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { | | | | 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 | } {1 {unknown command "thisdoesntexist"}} test trace-28.10 {exec trace info nonsense} { list [catch {trace remove execution} res] $res } {1 {wrong # args: should be "trace remove execution name opList command"}} test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace tracetest {set stuff [expr {14 + 16}]} } {{expr {14 + 16}} {expr {14 + 16}} {set stuff [expr {14 + 16}]} {set stuff 30}} test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace tracetest {set stuff [info tclversion]} } [concat {{info tclversion} {info tclversion} ::tcl::info::tclversion {::tcl::info::tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]] test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace deletetest {set stuff [info tclversion]} } [info tclversion] test trace-29.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults} {testcmdtrace} { |
︙ | ︙ |
Changes to tests/unixFCmd.test.
1 2 3 4 5 6 | # This file tests the tclUnixFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # This file tests the tclUnixFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] # These tests really need to be run from a writable directory, which # it is assumed [temporaryDirectory] is. set oldcwd [pwd] cd [temporaryDirectory] |
︙ | ︙ | |||
92 93 94 95 96 97 98 | cleanup } test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td1/td2/td3 | | | | 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | cleanup } test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td1/td2/td3 file attributes td1/td2 -permissions 0 file rename td1/td2/td3 td2 } -returnCodes error -cleanup { file attributes td1/td2 -permissions 0o755 cleanup } -result {error renaming "td1/td2/td3": permission denied} test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td1/td2 file mkdir td2 |
︙ | ︙ | |||
133 134 135 136 137 138 139 | test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} { # can't make it happen } {} test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir foo/bar | | | | 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} { # can't make it happen } {} test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir foo/bar file attr foo -perm 0o40555 file rename foo/bar /tmp } -returnCodes error -cleanup { catch {file delete /tmp/bar} catch {file attr foo -perm 0o40777} catch {file delete -force foo} } -match glob -result {*: permission denied} test unixFCmd-1.8 {Checking EINTR Bug} {unix notRoot nonPortable} { testalarm after 2000 list [testgotsig] [testgotsig] } {1 0} |
︙ | ︙ | |||
332 333 334 335 336 337 338 | file attributes foo.test -owner foozzz } -result {could not set owner for file "foo.test": user "foozzz" does not exist} test unixFCmd-17.1 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { close [open foo.test w] | | | | 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 | file attributes foo.test -owner foozzz } -result {could not set owner for file "foo.test": user "foozzz" does not exist} test unixFCmd-17.1 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { close [open foo.test w] list [file attributes foo.test -permissions 0] \ [file attributes foo.test -permissions] } -cleanup { file delete -force -- foo.test } -result {{} 00000} test unixFCmd-17.2 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -returnCodes error -body { file attributes foo.test -permissions 0 } -result {could not set permissions for file "foo.test": no such file or directory} test unixFCmd-17.3 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot} -body { close [open foo.test w] file attributes foo.test -permissions foo } -cleanup { |
︙ | ︙ | |||
386 387 388 389 390 391 392 | set cd [pwd] } -body { # This test is nonPortable because SunOS generates a weird error # message when the current directory isn't readable. set nd $cd/tstdir file mkdir $nd cd $nd | | | | 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | set cd [pwd] } -body { # This test is nonPortable because SunOS generates a weird error # message when the current directory isn't readable. set nd $cd/tstdir file mkdir $nd cd $nd file attributes $nd -permissions 0 pwd } -returnCodes error -cleanup { cd $cd file attributes $nd -permissions 0o755 file delete $nd } -match glob -result {error getting working directory name:*} test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} -setup { catch {file delete -force -- foo.test} } -constraints {unix notRoot readonlyAttr} -returnCodes error -body { file attributes foo.test -readonly |
︙ | ︙ |
Changes to tests/unixFile.test.
1 2 3 4 5 6 | # This file contains tests for the routines in the file tclUnixFile.c # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | # This file contains tests for the routines in the file tclUnixFile.c # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testfindexecutable [llength [info commands testfindexecutable]] set oldpwd [pwd] cd [temporaryDirectory] catch { set oldPath $env(PATH) file attributes [makeFile "" junk] -perm 0o777 } set absPath [file join [temporaryDirectory] junk] test unixFile-1.1 {Tcl_FindExecutable} {testfindexecutable unix} { set env(PATH) "" testfindexecutable junk } $absPath |
︙ | ︙ |
Changes to tests/unixForkEvent.test.
1 2 3 4 | # This file contains a collection of tests for the procedures in the file # tclUnixNotify.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | # This file contains a collection of tests for the procedures in the file # tclUnixNotify.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1995-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/unixInit.test.
1 2 3 4 5 6 | # The file tests the functions in the tclUnixInit.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # The file tests the functions in the tclUnixInit.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
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/unixNotfy.test.
1 2 3 4 5 6 | # This file contains tests for tclUnixNotfy.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # This file contains tests for tclUnixNotfy.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/unknown.test.
1 2 3 4 5 6 | # Commands covered: unknown # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | # Commands covered: unknown # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/unload.test.
1 2 3 4 5 6 | # Commands covered: unload # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # Commands covered: unload # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1995 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # Copyright © 2003-2004 Georgios Petasis # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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]] # Figure out what extension is used for shared libraries on this # platform. if {![info exists ext]} { set ext [info sharedlibextension] } # Tests require the existence of one of the DLLs in the dltest directory. set testDir [file join [file dirname [info nameofexecutable]] dltest] set x [file join $testDir pkgua$ext] set dll "[file tail $x]Required" testConstraint $dll [file readable $x] # 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 *pkgua* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] # Certain tests need the 'testsimplefilsystem' in tcltest testConstraint testsimplefilesystem \ [llength [info commands testsimplefilesystem]] proc loadIfNotPresent {pkg args} { global testDir ext set loaded [lmap x [info loaded {*}$args] {lindex $x 1}] if {[string totitle $pkg] ni $loaded} { load [file join $testDir $pkg$ext] } } # Basic tests: parameter testing... test unload-1.1 {basic errors} -returnCodes error -body { unload } -result {wrong # args: should be "unload ?-switch ...? fileName ?prefix? ?interp?"} test unload-1.2 {basic errors} -returnCodes error -body { unload a b c d } -result {wrong # args: should be "unload ?-switch ...? fileName ?prefix? ?interp?"} test unload-1.3 {basic errors} -returnCodes error -body { unload a b foobar } -result {could not find interpreter "foobar"} test unload-1.4 {basic errors} -returnCodes error -body { unload {} } -result {must specify either file name or prefix} test unload-1.5 {basic errors} -returnCodes error -body { unload {} {} } -result {must specify either file name or prefix} test unload-1.6 {basic errors} -returnCodes error -body { unload {} Unknown } -result {library with prefix "Unknown" is loaded statically and cannot be unloaded} test unload-1.7 {-nocomplain switch} { unload -nocomplain {} Unknown } {} set pkgua_loaded {} set pkgua_detached {} set pkgua_unloaded {} # Tests for loading/unloading in trusted (non-safe) interpreters... test unload-2.1 {basic loading of non-unloadable package, with guess for prefix} [list $dll $loaded] { loadIfNotPresent pkga list [pkga_eq abc def] [lsort [info commands pkga_*]] } {0 {pkga_eq pkga_quote}} test unload-2.2 {basic loading of unloadable package, with guess for prefix} [list $dll $loaded] { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [load [file join $testDir pkgua$ext]] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}} test unload-2.3 {basic unloading of non-unloadable package, with guess for prefix} -setup { loadIfNotPresent pkga } -constraints [list $dll $loaded] -returnCodes error -match glob -body { unload [file join $testDir pkga$ext] } -result {file "*" cannot be unloaded under a trusted interpreter} test unload-2.4 {basic unloading of unloadable package, with guess for prefix} -setup { loadIfNotPresent pkgua } -constraints [list $dll $loaded] -body { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [unload [file join $testDir pkgua$ext]] \ [info commands pkgua_*] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } -result {. {} {} {} {} . . .} test unload-2.5 {reloading of unloaded package, with guess for prefix} -setup { if {$pkgua_loaded eq ""} { loadIfNotPresent pkgua unload [file join $testDir pkgua$ext] } } -constraints [list $dll $loaded] -body { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [load [file join $testDir pkgua$ext]] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .} test unload-2.6 {basic unloading of re-loaded package, with guess for prefix} -setup { # Establish expected state if {$pkgua_loaded eq ""} { loadIfNotPresent pkgua unload [file join $testDir pkgua$ext] load [file join $testDir pkgua$ext] } } -constraints [list $dll $loaded] -body { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [unload [file join $testDir pkgua$ext]] \ [info commands pkgua_*] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } -result {.. . . {} {} .. .. ..} # Tests for loading/unloading in safe interpreters... interp create -safe child child eval { set pkgua_loaded {} set pkgua_detached {} set pkgua_unloaded {} } test unload-3.1 {basic loading of non-unloadable package in a safe interpreter} \ [list $dll $loaded] { catch {rename pkgb_sub {}} load [file join $testDir pkgb$ext] Pkgb child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} test unload-3.2 {basic loading of unloadable package in a safe interpreter} \ [list $dll $loaded] { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [load [file join $testDir pkgua$ext] Pkgua child] \ [child eval pkgua_eq abc def] \ [lsort [child eval info commands pkgua_*]] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup { loadIfNotPresent pkga } -constraints [list $dll $loaded] -returnCodes error -match glob -body { unload [file join $testDir pkga$ext] {} child } -result {file "*" has never been loaded in this interpreter} test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for prefix} -setup { if {[lsearch -index 1 [info loaded child] Pkgb] < 0} { load [file join $testDir pkgb$ext] Pkgb child } } -constraints [list $dll $loaded] -returnCodes error -match glob -body { unload [file join $testDir pkgb$ext] {} child } -result {file "*" cannot be unloaded under a safe interpreter} test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for prefix} -setup { if {[lsearch -index 1 [info loaded child] Pkgua] < 0} { load [file join $testDir pkgua$ext] Pkgua child } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [unload [file join $testDir pkgua$ext] {} child] \ [child eval info commands pkgua_*] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. {} {}} {} {} {. . .}} test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for prefix} -setup { if {[child eval set pkgua_loaded] eq ""} { load [file join $testDir pkgua$ext] {} child unload [file join $testDir pkgua$ext] {} child } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [load [file join $testDir pkgua$ext] {} child] \ [child eval pkgua_eq abc def] \ [lsort [child eval info commands pkgua_*]] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}} test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with prefix conversion} -setup { if {[child eval set pkgua_loaded] eq ""} { load [file join $testDir pkgua$ext] {} child unload [file join $testDir pkgua$ext] {} child load [file join $testDir pkgua$ext] {} child } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [unload [file join $testDir pkgua$ext] Pkgua child] \ [child eval info commands pkgua_*] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{.. . .} {} {} {.. .. ..}} # Tests for loading/unloading of a package among multiple interpreters... interp create child-trusted child-trusted eval { set pkgua_loaded {} set pkgua_detached {} set pkgua_unloaded {} } array set load {M 0 C 0 T 0} ## Load package in main trusted interpreter... test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for prefix} -setup { set pkgua_loaded "" set pkgua_detached "" set pkgua_unloaded "" incr load(M) } -constraints [list $dll $loaded] -body { list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ [load [file join $testDir pkgua$ext]] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] } -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} ## Load package in child-safe interpreter... test unload-4.2 {basic loading of unloadable package in a safe interpreter} -setup { child eval { set pkgua_loaded "" set pkgua_detached "" set pkgua_unloaded "" } incr load(C) } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [load [file join $testDir pkgua$ext] Pkgua child] \ [child eval pkgua_eq abc def] \ [lsort [child eval info commands pkgua_*]] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} ## Load package in child-trusted interpreter... test unload-4.3 {basic loading of unloadable package in a second trusted interpreter} -setup { incr load(T) } -constraints [list $dll $loaded] -body { list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [load [file join $testDir pkgua$ext] Pkgua child-trusted] \ [child-trusted eval pkgua_eq abc def] \ [lsort [child-trusted eval info commands pkgua_*]] \ [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} ## Unload the package from the main trusted interpreter... test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for prefix} -setup { if {!$load(M)} { load [file join $testDir pkgua$ext] } if {!$load(C)} { load [file join $testDir pkgua$ext] {} child incr load(C) } if {!$load(T)} { load [file join $testDir pkgua$ext] {} child-trusted incr load(T) } } -constraints [list $dll $loaded] -body { list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ [unload [file join $testDir pkgua$ext]] \ [info commands pkgua_*] \ [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] } -result {{. {} {}} {} {} {. . {}}} ## Unload the package from the child safe interpreter... test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for prefix} -setup { if {!$load(C)} { load [file join $testDir pkgua$ext] {} child } if {!$load(T)} { load [file join $testDir pkgua$ext] {} child-trusted incr load(T) } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [unload [file join $testDir pkgua$ext] {} child] \ [child eval info commands pkgua_*] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. {} {}} {} {} {. . {}}} ## Unload the package from the child trusted interpreter... test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for prefix} -setup { if {!$load(T)} { load [file join $testDir pkgua$ext] {} child-trusted } } -constraints [list $dll $loaded] -body { list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ [unload [file join $testDir pkgua$ext] {} child-trusted] \ [child-trusted eval info commands pkgua_*] \ [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. {} {}} {} {} {. . .}} test unload-5.1 {unload a module loaded from vfs} \ -constraints [list $dll $loaded testsimplefilesystem] \ -setup { set dir [pwd] cd $testDir testsimplefilesystem 1 load simplefs:/pkgua$ext Pkgua } \ -body { list [catch {unload simplefs:/pkgua$ext} msg] $msg } \ -result {0 {}} # cleanup |
︙ | ︙ |
Changes to tests/uplevel.test.
1 2 3 4 5 6 | # Commands covered: uplevel # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: uplevel # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } proc a {x y} { newset z [expr {$x + $y}] return $z } proc newset {name value} { uplevel set $name $value uplevel 1 {uplevel 1 {set xyz 22}} } |
︙ | ︙ |
Changes to tests/upvar.test.
1 2 3 4 5 6 | # Commands covered: 'upvar', 'namespace upvar' # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # Commands covered: 'upvar', 'namespace upvar' # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testupvar [llength [info commands testupvar]] test upvar-1.1 {reading variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2} proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a} p1 foo bar |
︙ | ︙ | |||
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.
1 2 3 4 | # This file contains a collection of tests for tclUtf.c # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # | | | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # This file contains a collection of tests for tclUtf.c # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}] testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}] testConstraint utf16 [expr {[string length [format %c 0x10000]] == 2}] testConstraint ucs4 [expr {[testConstraint fullutf] && [string length [format %c 0x10000]] == 1}] testConstraint Uesc [expr {"\U0041" eq "A"}] testConstraint pre388 [expr {"\x741" eq "A"}] testConstraint pairsTo4bytes [expr {[llength [info commands teststringbytes]] && [string length [teststringbytes \uD83D\uDCA9]] == 4}] testConstraint testbytestring [llength [info commands testbytestring]] |
︙ | ︙ | |||
46 47 48 49 50 51 52 | 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 |
︙ | ︙ | |||
100 101 102 103 104 105 106 | } 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. |
︙ | ︙ | |||
192 193 194 195 196 197 198 | 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 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 | 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 test utf-6.7 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext A[testbytestring \xF2] } 1 test utf-6.8 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext A[testbytestring \xF8] } 1 test utf-6.9 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\x00] } 1 test utf-6.10 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0]G } 1 test utf-6.11.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\x00] } 1 test utf-6.11.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\x00] } 2 test utf-6.12 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xD0] } 1 test utf-6.13 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xE8] |
︙ | ︙ | |||
249 250 251 252 253 254 255 | test utf-6.21 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xF2] } 1 test utf-6.22 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xF8] } 1 test utf-6.23 {Tcl_UtfNext} {testutfnext testbytestring} { | | | | | | | | | | | | 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 | test utf-6.21 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xF2] } 1 test utf-6.22 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xD0\xF8] } 1 test utf-6.23 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\x00] } 1 test utf-6.24 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8]G } 1 test utf-6.25 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xA0\x00] } 1 test utf-6.26 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xD0] } 1 test utf-6.27 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xE8] } 1 test utf-6.28 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xF2] } 1 test utf-6.29 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xE8\xF8] } 1 test utf-6.30.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2] } 1 test utf-6.30.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\x00] } 1 test utf-6.31 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2]G } 1 test utf-6.32.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0] } 1 test utf-6.32.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\x00] } 1 test utf-6.33 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xD0] } 1 test utf-6.34 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xE8] } 1 test utf-6.35 {Tcl_UtfNext} {testutfnext testbytestring} { |
︙ | ︙ | |||
339 340 341 342 343 344 345 | 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 |
︙ | ︙ | |||
372 373 374 375 376 377 378 | 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 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 | 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 test utf-6.69.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0] } 4 test utf-6.70 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xD0] } 1 test utf-6.71 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xE8] } 1 test utf-6.72 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xF2] } 1 test utf-6.73 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xF2\xA0\xA0\xF8] } 1 test utf-6.74.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G } 1 test utf-6.74.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0]G } 4 test utf-6.75.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] } 1 test utf-6.75.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] } 4 test utf-6.76.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0] } 1 test utf-6.76.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0] } 4 test utf-6.77.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8] } 1 test utf-6.77.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8] } 4 test utf-6.78.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2] } 1 test utf-6.78.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2] } 4 test utf-6.79.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8] } 1 test utf-6.79.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8] } 4 test utf-6.80 {Tcl_UtfNext - overlong sequences} testutfnext { testutfnext \x00 } 2 test utf-6.81 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xC0\x81] |
︙ | ︙ | |||
467 468 469 470 471 472 473 | } 1 test utf-6.85 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xE0\xA0\x80] } 3 test utf-6.86 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xF0\x80\x80\x80] } 1 | | | | > > > | > > > | | | > > > | > > > | > > > | > > > | 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 | } 1 test utf-6.85 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xE0\xA0\x80] } 3 test utf-6.86 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { testutfnext [testbytestring \xF0\x80\x80\x80] } 1 test utf-6.87.0 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF0\x90\x80\x80] } 1 test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF0\x90\x80\x80] } 4 test utf-6.88.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\x00] } 1 test utf-6.88.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\x00] } 2 test utf-6.89.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \x80\x80\x00] } 1 test utf-6.89.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \x80\x80\x00] } 2 test utf-6.90.0 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xF4\x8F\xBF\xBF] } 1 test utf-6.90.1 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xF4\x8F\xBF\xBF] } 4 test utf-6.91 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring} { testutfnext [testbytestring \xF4\x90\x80\x80] } 1 test utf-6.92.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\xA0] } 1 test utf-6.92.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\xA0] } 3 test utf-6.93.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \x80\x80\x80] } 1 test utf-6.93.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \x80\x80\x80] } 3 test utf-6.94.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \xA0\xA0\xA0\xA0] } 1 test utf-6.94.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \xA0\xA0\xA0\xA0] } 3 test utf-6.95.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} { testutfnext [testbytestring \x80\x80\x80\x80] } 1 test utf-6.95.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring fullutf} { testutfnext [testbytestring \x80\x80\x80\x80] } 3 test utf-7.1 {Tcl_UtfPrev} testutfprev { testutfprev {} } 0 test utf-7.2 {Tcl_UtfPrev} testutfprev { |
︙ | ︙ | |||
532 533 534 535 536 537 538 | 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 |
︙ | ︙ | |||
586 587 588 589 590 591 592 | 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 |
︙ | ︙ | |||
640 641 642 643 644 645 646 | 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 745 | 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 test utf-7.26 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { |
︙ | ︙ | |||
702 703 704 705 706 707 708 | } 2 test utf-7.28 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0] } 1 test utf-7.28.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\x80\x80] 2 } 1 | | | | 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 | } 2 test utf-7.28 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0] } 1 test utf-7.28.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\x80\x80] 2 } 1 test utf-7.29 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xF0\x80\x80\x80] } 4 test utf-7.30 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xF0\x80\x80\x80] 4 } 3 test utf-7.31 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xF0\x80\x80\x80] 3 } 2 test utf-7.32 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { |
︙ | ︙ | |||
732 733 734 735 736 737 738 | } 1 test utf-7.37 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\xA0\x80] 3 } 1 test utf-7.38 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\xA0\x80] 2 } 1 | | | > > > | 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 | } 1 test utf-7.37 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\xA0\x80] 3 } 1 test utf-7.38 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\xA0\x80] 2 } 1 test utf-7.39.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF0\x90\x80\x80] } 4 test utf-7.39.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF0\x90\x80\x80] } 1 test utf-7.40.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF0\x90\x80\x80] 4 } 3 test utf-7.40.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF0\x90\x80\x80] 4 } 1 test utf-7.41.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { |
︙ | ︙ | |||
759 760 761 762 763 764 765 | } 0 test utf-7.44 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { testutfprev [testbytestring \xA0\xA0] } 1 test utf-7.45 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { testutfprev [testbytestring \xA0\xA0\xA0] } 2 | | | | | | | > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 | } 0 test utf-7.44 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { testutfprev [testbytestring \xA0\xA0] } 1 test utf-7.45 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { testutfprev [testbytestring \xA0\xA0\xA0] } 2 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 test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] } 1 test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 } 3 test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 } 1 test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 } 2 test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 } 1 test utf-7.48.6 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 2 } 1 test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x90\x80\x80] } 4 test utf-7.49.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x90\x80\x80] 4 } 3 test utf-7.49.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x90\x80\x80] 3 } 2 test utf-7.49.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { 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 \U1F600G 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 |
︙ | ︙ | |||
1024 1025 1026 1027 1028 1029 1030 | 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 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 | 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 { unset -nocomplain foo } -result {1 4} test utf-20.1 {TclUniCharNcmp} ucs4 { string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0] } -1 test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} { set one [format %c 0xFFFF] set two [format %c 0x10000] set first [string compare $one $two] string range $one 0 0 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] |
︙ | ︙ | |||
1232 1233 1234 1235 1236 1237 1238 | 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} { |
︙ | ︙ | |||
1297 1298 1299 1300 1301 1302 1303 | } 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.
1 2 3 | # This file is a Tcl script to test the code in the file tclUtil.c. # This file is organized in the standard fashion for Tcl tests. # | | | | | | | | | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # This file is a Tcl script to test the code in the file tclUtil.c. # This file is organized in the standard fashion for Tcl tests. # # Copyright © 1995-1998 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 controversialNaN 1 testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] testConstraint testconcatobj [llength [info commands testconcatobj]] testConstraint testdoubledigits [llength [info commands testdoubledigits]] testConstraint testprint [llength [info commands testprint]] # 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) 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 } |
︙ | ︙ | |||
98 99 100 101 102 103 104 | return $result } proc verdonk_test {sig binexp shouldbe exp} { regexp {([-+]?)([0-9a-f]+)} $sig -> signum sig scan $sig %llx sig if {$signum eq {-}} { | | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | return $result } proc verdonk_test {sig binexp shouldbe exp} { regexp {([-+]?)([0-9a-f]+)} $sig -> signum sig scan $sig %llx sig if {$signum eq {-}} { set signum [expr {1<<63}] } else { set signum 0 } regexp {E([-+]?[0-9]+)} $binexp -> binexp set word [expr {$signum | (($binexp + 0x3ff)<<52)|($sig & ~(1<<52))}] binary scan [binary format w $word] q double regexp {([-+])(\d+)_(\d+)\&} $shouldbe -> signum digits1 digits2 |
︙ | ︙ | |||
200 201 202 203 204 205 206 | 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} { | | | | > > > | 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 | 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 |
︙ | ︙ | |||
232 233 234 235 236 237 238 | 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} { | | | | | | | | | | | | | | 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 | 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 |
︙ | ︙ | |||
349 350 351 352 353 354 355 | 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 ']'} { | | | | | 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 | 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} { |
︙ | ︙ | |||
381 382 383 384 385 386 387 | 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} { | | | | | | | | | | | | 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 | 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.5 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr {2.0}] } {x2.0} test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr {3.0e98}] } {x3e+98} # This test always succeeded in the C locale anyway... 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 |
︙ | ︙ | |||
446 447 448 449 450 451 452 | testdstring free testdstring append {\\ } -1 testdstring append \{ -1 testdstring element foo testdstring append \} -1 list [llength [testdstring get]] [string length [testdstring get]] } {2 8} | | | | | | | 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 | testdstring free testdstring append {\\ } -1 testdstring append \{ -1 testdstring element foo testdstring append \} -1 list [llength [testdstring get]] [string length [testdstring get]] } {2 8} test util-8.7 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\ } -1 testdstring start testdstring end # Should make {\ {}} list [llength [testdstring get]] [string index [testdstring get] 3] } {2 \{} test util-8.8 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\\ } -1 testdstring start testdstring end # Should make {\\ {}} list [llength [testdstring get]] [string index [testdstring get] 3] } {2 \{} test util-8.9 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\\\ } -1 testdstring start testdstring end # Should make {\\\ {}} list [llength [testdstring get]] [string index [testdstring get] 5] } {2 \{} test util-8.10 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\\\\\\\ } -1 testdstring start testdstring end # Should make {\\\\\\\ {}} list [llength [testdstring get]] [string index [testdstring get] 9] } {2 \{} test util-8.11 {TclNeedSpace - watch out for escaped space} testdstring { testdstring free testdstring append {\\\\\\\\ } -1 testdstring start testdstring end # Should make {\\\\\\\\ {}} list [llength [testdstring get]] [string index [testdstring get] 9] |
︙ | ︙ | |||
1107 1108 1109 1110 1111 1112 1113 | convertDouble 0x3dbc06d366394441 } {2.54901016865e-11} test util-10.122 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x478f58ac4db68c90 } {5.20831059055e+36} test util-11.1 {Tcl_PrintDouble - scaling} { | | | | | | | | | | | | | | | | | | | | | | | | | 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 | convertDouble 0x3dbc06d366394441 } {2.54901016865e-11} test util-10.122 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x478f58ac4db68c90 } {5.20831059055e+36} test util-11.1 {Tcl_PrintDouble - scaling} { expr {1.1e-5} } {1.1e-5} test util-11.2 {Tcl_PrintDouble - scaling} { expr {1.1e-4} } {0.00011} test util-11.3 {Tcl_PrintDouble - scaling} { expr {1.1e-3} } {0.0011} test util-11.4 {Tcl_PrintDouble - scaling} { expr {1.1e-2} } {0.011} test util-11.5 {Tcl_PrintDouble - scaling} { expr {1.1e-1} } {0.11} test util-11.6 {Tcl_PrintDouble - scaling} { expr {1.1e0} } {1.1} test util-11.7 {Tcl_PrintDouble - scaling} { expr {1.1e1} } {11.0} test util-11.8 {Tcl_PrintDouble - scaling} { expr {1.1e2} } {110.0} test util-11.9 {Tcl_PrintDouble - scaling} { expr {1.1e3} } {1100.0} test util-11.10 {Tcl_PrintDouble - scaling} { expr {1.1e4} } {11000.0} test util-11.11 {Tcl_PrintDouble - scaling} { expr {1.1e5} } {110000.0} test util-11.12 {Tcl_PrintDouble - scaling} { expr {1.1e6} } {1100000.0} test util-11.13 {Tcl_PrintDouble - scaling} { expr {1.1e7} } {11000000.0} test util-11.14 {Tcl_PrintDouble - scaling} { expr {1.1e8} } {110000000.0} test util-11.15 {Tcl_PrintDouble - scaling} { expr {1.1e9} } {1100000000.0} test util-11.16 {Tcl_PrintDouble - scaling} { expr {1.1e10} } {11000000000.0} test util-11.17 {Tcl_PrintDouble - scaling} { expr {1.1e11} } {110000000000.0} test util-11.18 {Tcl_PrintDouble - scaling} { expr {1.1e12} } {1100000000000.0} test util-11.19 {Tcl_PrintDouble - scaling} { expr {1.1e13} } {11000000000000.0} test util-11.20 {Tcl_PrintDouble - scaling} { expr {1.1e14} } {110000000000000.0} test util-11.21 {Tcl_PrintDouble - scaling} { expr {1.1e15} } {1100000000000000.0} test util-11.22 {Tcl_PrintDouble - scaling} { expr {1.1e16} } {11000000000000000.0} test util-11.23 {Tcl_PrintDouble - scaling} { expr {1.1e17} } {1.1e+17} test util-12.1 {TclDoubleDigits - Inf} {testdoubledigits ieeeFloatingPoint} { testdoubledigits Inf -1 shortest } {Infinity 9999 +} test util-12.2 {TclDoubleDigits - -Inf} {testdoubledigits ieeeFloatingPoint} { testdoubledigits -Inf -1 shortest |
︙ | ︙ | |||
2159 2160 2161 2162 2163 2164 2165 | 0x1ffffffffffffd000 0x1ffffffffffffd800 0x1ffffffffffffe000 0x1ffffffffffffe800 0x1fffffffffffff000 0x1fffffffffffff800 } { | | | | | | | | | | | | | 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 | 0x1ffffffffffffd000 0x1ffffffffffffd800 0x1ffffffffffffe000 0x1ffffffffffffe800 0x1fffffffffffff000 0x1fffffffffffff800 } { binary scan [binary format q [expr {double($input)}]] wu x lappend r [format %#llx $x] binary scan [binary format q [expr {double(-$input)}]] wu x lappend r [format %#llx $x] } set r } [list {*}{ 0x43fffffffffffffc 0xc3fffffffffffffc 0x43fffffffffffffc 0xc3fffffffffffffc 0x43fffffffffffffd 0xc3fffffffffffffd 0x43fffffffffffffe 0xc3fffffffffffffe 0x43fffffffffffffe 0xc3fffffffffffffe 0x43fffffffffffffe 0xc3fffffffffffffe 0x43ffffffffffffff 0xc3ffffffffffffff 0x4400000000000000 0xc400000000000000 }] test util-18.1 {Tcl_ObjPrintf} {testprint} { testprint %lld [expr {2**63-1}] } {9223372036854775807} test util-18.2 {Tcl_ObjPrintf} {testprint} { testprint %I64d [expr {2**63-1}] } {9223372036854775807} test util-18.3 {Tcl_ObjPrintf} {testprint} { testprint %qd [expr {2**63-1}] } {9223372036854775807} test util-18.4 {Tcl_ObjPrintf} {testprint} { testprint %jd [expr {2**63-1}] } {9223372036854775807} test util-18.5 {Tcl_ObjPrintf} {testprint} { testprint %lld [expr {-2**63}] } {-9223372036854775808} test util-18.6 {Tcl_ObjPrintf} {testprint} { testprint %I64d [expr {-2**63}] } {-9223372036854775808} test util-18.7 {Tcl_ObjPrintf} {testprint} { testprint %qd [expr {-2**63}] } {-9223372036854775808} test util-18.8 {Tcl_ObjPrintf} {testprint} { testprint %jd [expr {-2**63}] } {-9223372036854775808} test util-18.9 {Tcl_ObjPrintf} {testprint} { testprint "%I64d %I32d" [expr {-2**63+2}] } {-9223372036854775806 2} test util-18.10 {Tcl_ObjPrintf} {testprint} { testprint "%I64d %p" 65535 } {65535 0xffff} test util-18.11 {Tcl_ObjPrintf} {testprint} { |
︙ | ︙ |
Changes to tests/var.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains tests for the tclVar.c source file. Tests appear in the # same order as the C code that they test. The set of tests is currently # incomplete since it currently includes only new tests for code changed for # the addition of Tcl namespaces. Other variable-related tests appear in # several other test files including namespace.test, set.test, trace.test, and # upvar.test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # This file contains tests for the tclVar.c source file. Tests appear in the # same order as the C code that they test. The set of tests is currently # incomplete since it currently includes only new tests for code changed for # the addition of Tcl namespaces. Other variable-related tests appear in # several other test files including namespace.test, set.test, trace.test, and # upvar.test. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testupvar [llength [info commands testupvar]] testConstraint testgetvarfullname [llength [info commands testgetvarfullname]] testConstraint testsetnoerr [llength [info commands testsetnoerr]] testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { |
︙ | ︙ | |||
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 { |
︙ | ︙ | |||
449 450 451 452 453 454 455 | catch {namespace delete test_ns_var} namespace eval test_ns_var {variable one 1; variable two 2} } -body { namespace eval test_ns_var { variable three 3 four 4 } list [lsort [info vars test_ns_var::*]] \ | | | 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 | catch {namespace delete test_ns_var} namespace eval test_ns_var {variable one 1; variable two 2} } -body { namespace eval test_ns_var { variable three 3 four 4 } list [lsort [info vars test_ns_var::*]] \ [namespace eval test_ns_var {expr {$three+$four}}] } -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7] test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup { catch {unset a} catch {unset five} catch {unset six} } -body { set a "" |
︙ | ︙ |
Changes to tests/while-old.test.
1 2 3 4 5 6 7 8 | # Commands covered: while # # This file contains the original set of tests for Tcl's while command. # Since the while command is now compiled, a new set of tests covering # the new implementation is in the file "while.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # Commands covered: while # # This file contains the original set of tests for Tcl's while command. # Since the while command is now compiled, a new set of tests covering # the new implementation is in the file "while.test". Sourcing this file # into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } test while-old-1.1 {basic while loops} { set count 0 while {$count < 10} {set count [expr {$count + 1}]} set count } 10 test while-old-1.2 {basic while loops} { set value xxx while {2 > 3} {set value yyy} set value } xxx |
︙ | ︙ | |||
54 55 56 57 58 59 60 | } {2} test while-old-2.1 {continue in while loop} { set list {1 2 3 4 5} set index 0 set result {} while {$index < 5} { | | | | | 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 | } {2} test while-old-2.1 {continue in while loop} { set list {1 2 3 4 5} set index 0 set result {} while {$index < 5} { if {$index == 2} {set index [expr {$index + 1}]; continue} set result [concat $result [lindex $list $index]] set index [expr {$index + 1}] } set result } {1 2 4 5} test while-old-3.1 {break in while loop} { set list {1 2 3 4 5} set index 0 set result {} while {$index < 5} { if {$index == 3} break set result [concat $result [lindex $list $index]] set index [expr {$index + 1}] } set result } {1 2 3} test while-old-4.1 {errors in while loops} { set err [catch {while} msg] list $err $msg |
︙ | ︙ |
Changes to tests/while.test.
1 2 3 4 5 6 | # Commands covered: while # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # Commands covered: while # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
73 74 75 76 77 78 79 | } -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test while-1.9 {TclCompileWhileCmd: simple command body} -body { set a {} set i 1 while {$i<6} { | | | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | } -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} test while-1.9 {TclCompileWhileCmd: simple command body} -body { set a {} set i 1 while {$i<6} { if {$i==4} break set a [concat $a $i] incr i } return $a } -cleanup { unset a i } -result {1 2 3} |
︙ | ︙ | |||
108 109 110 111 112 113 114 | } -cleanup { unset x1 bb x2 a i } -result {x1} test while-1.12 {TclCompileWhileCmd: long command body} -body { set a {} set i 1 while {$i<6} { | | | | 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | } -cleanup { unset x1 bb x2 a i } -result {x1} test while-1.12 {TclCompileWhileCmd: long command body} -body { set a {} set i 1 while {$i<6} { if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ | |||
151 152 153 154 155 156 157 | set a [while {$i < 5} {incr i}] return $a } -cleanup { unset a i } -result {} test while-1.14 {TclCompileWhileCmd: while command result} -body { set i 0 | | | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 | set a [while {$i < 5} {incr i}] return $a } -cleanup { unset a i } -result {} test while-1.14 {TclCompileWhileCmd: while command result} -body { set i 0 set a [while {$i < 5} {if {$i==3} break; incr i}] return $a } -cleanup { unset a i } -result {} # Check "while" and "continue". |
︙ | ︙ | |||
203 204 205 206 207 208 209 | } -cleanup { unset a i msg } -result {2.2 2.3 3.2 4.2 5.2} test while-2.4 {continue tests, long command body} -body { set a {} set i 1 while {$i<6} { | | | | | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | } -cleanup { unset a i msg } -result {2.2 2.3 3.2 4.2 5.2} test while-2.4 {continue tests, long command body} -body { set a {} set i 1 while {$i<6} { if {$i==2} {incr i; continue} if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ | |||
273 274 275 276 277 278 279 | } -cleanup { unset a i msg } -result {1.1 1.2 2.1 3.1 4.1} test while-3.3 {break tests, long command body} -body { set a {} set i 1 while {$i<6} { | | | | | | 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 | } -cleanup { unset a i msg } -result {1.1 1.2 2.1 3.1 4.1} test while-3.3 {break tests, long command body} -body { set a {} set i 1 while {$i<6} { if {$i==2} {incr i; continue} if {$i==5} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i==4} break if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ | |||
397 398 399 400 401 402 403 | invoked from within "$z {$i < 5} {set}"} test while-4.10 {while (not compiled): simple command body} -body { set a {} set i 1 set z while $z {$i<6} { | | | 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 | invoked from within "$z {$i < 5} {set}"} test while-4.10 {while (not compiled): simple command body} -body { set a {} set i 1 set z while $z {$i<6} { if {$i==4} break set a [concat $a $i] incr i } return $a } -cleanup { unset a i z } -result {1 2 3} |
︙ | ︙ | |||
435 436 437 438 439 440 441 | unset z x1 bb x2 a i } -result {x1} test while-4.13 {while (not compiled): long command body} -body { set a {} set z while set i 1 $z {$i<6} { | | | | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 | unset z x1 bb x2 a i } -result {x1} test while-4.13 {while (not compiled): long command body} -body { set a {} set z while set i 1 $z {$i<6} { if {$i==4} break if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ | |||
480 481 482 483 484 485 486 | return $a } -cleanup { unset a i z } -result {} test while-4.15 {while (not compiled): while command result} -body { set i 0 set z while | | | 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 | return $a } -cleanup { unset a i z } -result {} test while-4.15 {while (not compiled): while command result} -body { set i 0 set z while set a [$z {$i < 5} {if {$i==3} break; incr i}] return $a } -cleanup { unset a i z } -result {} # Check "break" with computed command names. |
︙ | ︙ | |||
534 535 536 537 538 539 540 | unset a i z msg } -result {1.1 1.2 2.1 3.1 4.1} test while-5.4 {break tests, long command body with computed command names} -body { set a {} set i 1 set z break while {$i<6} { | | | | | | 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 | unset a i z msg } -result {1.1 1.2 2.1 3.1 4.1} test while-5.4 {break tests, long command body with computed command names} -body { set a {} set i 1 set z break while {$i<6} { if {$i==2} {incr i; continue} if {$i==5} $z if {$i>5} continue if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i==4} $z if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ | |||
633 634 635 636 637 638 639 | unset a i z msg } -result {2.2 2.3 3.2 4.2 5.2} test while-6.5 {continue tests, long command body with computed command names} -body { set a {} set i 1 set z continue while {$i<6} { | | | | | 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 | unset a i z msg } -result {2.2 2.3 3.2 4.2 5.2} test while-6.5 {continue tests, long command body with computed command names} -body { set a {} set i 1 set z continue while {$i<6} { if {$i==2} {incr i; continue} if {$i==4} break if {$i>5} $z if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg catch {incr i 5} msg catch {incr i -5} msg } if {$i>6 && $tcl_platform(machine)=="xxx"} { catch {set a $a} msg |
︙ | ︙ |
Changes to tests/winConsole.test.
1 2 3 4 5 6 | # This file tests the tclWinConsole.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # This file tests the tclWinConsole.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ |
Changes to tests/winDde.test.
1 2 3 4 5 6 | # This file tests the tclWinDde.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | # This file tests the tclWinDde.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint debug [::tcl::pkgconfig get debug] 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 } } testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] # ------------------------------------------------------------------------- # Setup a script for a test server # 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 namespace import -force ::tcltest::* } |
︙ | ︙ | |||
100 101 102 103 104 105 106 | gets $f line return $f } # ------------------------------------------------------------------------- test winDde-1.0 {check if we are testing the right dll} {win dde} { set ::ddever | | | | | | 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 | gets $f line return $f } # ------------------------------------------------------------------------- test winDde-1.0 {check if we are testing the right dll} {win dde} { set ::ddever } {1.4.4} test winDde-1.1 {Settings the server's topic name} -constraints dde -body { list [dde servername foobar] [dde servername] [dde servername self] } -result {foobar foobar self} test winDde-2.1 {Checking for other services} -constraints dde -body { expr {[llength [dde services {} {}]] >= 0} } -result 1 test winDde-2.2 {Checking for existence, with service and topic specified} \ -constraints dde -body { llength [dde services TclEval self] } -result 1 test winDde-2.3 {Checking for existence, with only the service specified} \ -constraints dde -body { expr {[llength [dde services TclEval {}]] >= 1} } -result 1 test winDde-2.4 {Checking for existence, with only the topic specified} \ -constraints dde -body { expr {[llength [dde services {} self]] >= 1} } -result 1 # ------------------------------------------------------------------------- test winDde-3.1 {DDE execute locally} -constraints dde -body { set \xe1 "" dde execute TclEval self [list set \xe1 foo] |
︙ | ︙ |
Changes to tests/winFCmd.test.
1 2 3 4 5 6 | # This file tests the tclWinFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | < < > > | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # This file tests the tclWinFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1996-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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]] # Initialise the test constraints testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint testfile [llength [info commands testfile]] 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 {![info exists ::env(CI_BUILD_WITH_MSVC)]}] proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string close $f return $string } |
︙ | ︙ | |||
53 54 55 56 57 58 59 | } if {$x != ""} { catch {file delete -force -- {*}$x} } } } | < < < < < < < < | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | } if {$x != ""} { catch {file delete -force -- {*}$x} } } } # find a CD-ROM so we can test read-only filesystems. proc findfile {dir} { foreach p [glob -nocomplain -type f -directory $dir *] { return $p } foreach p [glob -nocomplain -type d -directory $dir *] { |
︙ | ︙ | |||
129 130 131 132 133 134 135 | # low-level posix emulation layer. test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body { testfile mv $cdfile $cdrom/dummy~~.fil } -constraints {win cdrom testfile} -returnCodes error -result EACCES test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup { cleanup | | | | | | 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 | # low-level posix emulation layer. test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body { testfile mv $cdfile $cdrom/dummy~~.fil } -constraints {win cdrom testfile} -returnCodes error -result EACCES test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup { cleanup } -constraints {win testfile notInCIenv} -body { file mkdir td1/td2/td3 file mkdir td2 testfile mv td2 td1/td2 } -returnCodes error -result EEXIST test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} -setup { cleanup } -constraints {win testfile notInCIenv} -body { testfile mv / td1 } -returnCodes error -result EINVAL test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup { cleanup } -constraints {win testfile notInCIenv} -body { file mkdir td1 testfile mv td1 td1/td2 } -returnCodes error -result EINVAL test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} -setup { cleanup } -constraints {win testfile notInCIenv} -body { file mkdir td1 createfile tf1 testfile mv tf1 td1 } -returnCodes error -result EISDIR test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} -setup { cleanup } -constraints {win testfile} -body { |
︙ | ︙ | |||
200 201 202 203 204 205 206 | } -constraints {win testfile} -body { createfile tf1 set fd [open tf2 w] testfile mv tf1 tf2 } -cleanup { catch {close $fd} } -returnCodes error -result EACCES | < < < < < | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 | } -constraints {win testfile} -body { createfile tf1 set fd [open tf2 w] testfile mv tf1 tf2 } -cleanup { catch {close $fd} } -returnCodes error -result EACCES test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 testfile mv tf1 nul } -returnCodes error -result EEXIST test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} -setup { |
︙ | ︙ | |||
228 229 230 231 232 233 234 | testfile mv tf1 tf2 } -returnCodes error -result ENOENT test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} -setup { cleanup } -constraints {win testfile} -body { testfile mv tf1 tf2 } -returnCodes error -result ENOENT | < < < < < | | 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 | testfile mv tf1 tf2 } -returnCodes error -result ENOENT test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} -setup { cleanup } -constraints {win testfile} -body { testfile mv tf1 tf2 } -returnCodes error -result ENOENT test winFCmd-1.20 {TclpRenameFile: src is dir} -setup { cleanup } -constraints {win testfile} -body { file delete /tf1 testfile mv [pwd] /tf1 } -returnCodes error -result EACCES test winFCmd-1.21 {TclpRenameFile: long src} -setup { cleanup } -constraints {win testfile} -body { testfile mv $longname tf1 } -returnCodes error -result ENAMETOOLONG test winFCmd-1.22 {TclpRenameFile: long dst} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 testfile mv tf1 $longname } -returnCodes error -result ENAMETOOLONG test winFCmd-1.23 {TclpRenameFile: move dir into self} -setup { cleanup } -constraints {win testfile notInCIenv} -body { file mkdir td1 testfile mv [pwd]/td1 td1/td2 } -returnCodes error -result EINVAL test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup { cleanup } -constraints {win testfile} -body { testfile mv / c:/ |
︙ | ︙ | |||
297 298 299 300 301 302 303 | } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv td1 tf1 } -returnCodes error -result ENOTDIR test winFCmd-1.30 {TclpRenameFile: dst is dir} -setup { cleanup | | | | | 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 | } -constraints {win testfile} -body { file mkdir td1 createfile tf1 testfile mv td1 tf1 } -returnCodes error -result ENOTDIR test winFCmd-1.30 {TclpRenameFile: dst is dir} -setup { cleanup } -constraints {win testfile notInCIenv} -body { file mkdir td1 file mkdir td2/td2 testfile mv td1 td2 } -returnCodes error -result EEXIST test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} -setup { cleanup } -constraints {win testfile notInCIenv} -body { file mkdir td1 file mkdir td2/td2 testfile mv td1 td2 } -returnCodes error -result EEXIST test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup { cleanup } -constraints {win testfile notInCIenv} -body { file mkdir td1/td2 file mkdir td2 testfile mv td1 td2 list [file exists td1] [file exists td2] [file exists td2/td2] } -result {0 1 1} test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \ -constraints {win exdev testfile testchmod} -body { |
︙ | ︙ | |||
340 341 342 343 344 345 346 | createfile tf1 testfile mv td1 tf1 } -cleanup { cleanup } -returnCodes error -result ENOTDIR test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup { cleanup | | | 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 | createfile tf1 testfile mv td1 tf1 } -cleanup { cleanup } -returnCodes error -result ENOTDIR test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup { cleanup } -constraints {win testfile notInCIenv} -body { file mkdir td1 createfile tf1 testfile mv tf1 td1 } -cleanup { cleanup } -returnCodes error -result EISDIR test winFCmd-1.36 {TclpRenameFile: src and dst not dir} -setup { |
︙ | ︙ | |||
391 392 393 394 395 396 397 | lappend inodes $stat(ino) unset stat } } test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup { cleanup | | | 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 | lappend inodes $stat(ino) unset stat } } test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup { cleanup } -constraints {win winNonZeroInodes knownMsvcBug notInCIenv} -body { file mkdir td1 foreach {a b} [MakeFiles td1] break file rename -force $a $b file exists $a } -cleanup { cleanup } -result {0} |
︙ | ︙ | |||
441 442 443 444 445 446 447 | cleanup } -constraints {win testfile} -body { createfile tf1 testfile cp tf1 "" } -cleanup { cleanup } -returnCodes error -result ENOENT | < < < < < | 423 424 425 426 427 428 429 430 431 432 433 434 435 436 | cleanup } -constraints {win testfile} -body { createfile tf1 testfile cp tf1 "" } -cleanup { cleanup } -returnCodes error -result ENOENT test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 tf1 testfile cp tf1 tf2 list [contents tf1] [contents tf2] } -cleanup { |
︙ | ︙ | |||
636 637 638 639 640 641 642 | list [file type td1] [file type td2] } -cleanup { cleanup } -result {directory directory} test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup { cleanup | | | 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 | list [file type td1] [file type td2] } -cleanup { cleanup } -result {directory directory} test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup { cleanup } -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { catch {testchmod 0o666 td1} cleanup |
︙ | ︙ | |||
690 691 692 693 694 695 696 | cleanup } -constraints {win testfile} -body { createfile tf1 list [catch {testfile rmdir tf1} msg] [file tail $msg] } -result {1 {tf1 ENOTDIR}} test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup { cleanup | | | | | 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 | cleanup } -constraints {win testfile} -body { createfile tf1 list [catch {testfile rmdir tf1} msg] [file tail $msg] } -result {1 {tf1 ENOTDIR}} test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup { cleanup } -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { catch {testchmod 0o666 td1} cleanup } -result {td1 EACCES} test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup { cleanup } -constraints {win testfile notInCIenv} -body { testfile rmdir / # WinXP returns EEXIST, WinNT seems to return EACCES. No policy # decision has been made as to which is correct. } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$} test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup { cleanup } -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 file exists td1 } -cleanup { catch {testchmod 0o666 td1} cleanup |
︙ | ︙ | |||
937 938 939 940 941 942 943 | } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 testfile rmdir -force td1 } -result {} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup | | | 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 | } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 testfile rmdir -force td1 } -result {} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup } -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body { file mkdir td1/td2 testchmod 0 td1 testfile rmdir -force td1 file exists td1 } -cleanup { catch {testchmod 0o666 td1} cleanup |
︙ | ︙ | |||
1050 1051 1052 1053 1054 1055 1056 | string tolower [file attributes ./td1 -longname] } -cleanup { cleanup } -result {./td1} test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body { list [file attributes / -longname] [file attributes \\ -longname] } -constraints {win} -result {/ /} | | < < < < < < < < | 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 | string tolower [file attributes ./td1 -longname] } -cleanup { cleanup } -result {./td1} test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body { list [file attributes / -longname] [file attributes \\ -longname] } -constraints {win} -result {/ /} test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup { catch {file delete -force -- $::env(TEMP)/td1} } -constraints {win} -body { createfile $::env(TEMP)/td1 {} string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \ [string tolower [file normalize $::env(TEMP)]/td1] } -cleanup { file delete -force -- $::env(TEMP)/td1 |
︙ | ︙ | |||
1126 1127 1128 1129 1130 1131 1132 | cleanup } -body { createfile td1 {} list [file attributes td1 -archive 1] [file attributes td1 -archive] } -cleanup { cleanup } -result {{} 1} | | | | 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 | cleanup } -body { createfile td1 {} list [file attributes td1 -archive 1] [file attributes td1 -archive] } -cleanup { cleanup } -result {{} 1} test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win notInCIenv} -setup { cleanup } -body { createfile td1 {} list [file attributes td1 -archive 0] [file attributes td1 -archive] } -cleanup { cleanup } -result {{} 0} test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win notInCIenv} -setup { cleanup } -body { createfile td1 {} list [file attributes td1 -hidden 1] [file attributes td1 -hidden] \ [file attributes td1 -hidden 0] } -cleanup { cleanup |
︙ | ︙ | |||
1167 1168 1169 1170 1171 1172 1173 | cleanup } -constraints {win} -body { createfile td1 {} list [file attributes td1 -readonly 0] [file attributes td1 -readonly] } -cleanup { cleanup } -result {{} 0} | | | 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 | cleanup } -constraints {win} -body { createfile td1 {} list [file attributes td1 -readonly 0] [file attributes td1 -readonly] } -cleanup { cleanup } -result {{} 0} test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win notInCIenv} -setup { cleanup } -body { createfile td1 {} list [file attributes td1 -system 1] [file attributes td1 -system] } -cleanup { cleanup } -result {{} 1} |
︙ | ︙ |
Changes to tests/winFile.test.
1 2 3 4 5 6 | # This file tests the tclWinFile.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | # This file tests the tclWinFile.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testvolumetype [llength [info commands testvolumetype]] testConstraint notNTFS 0 if {[testConstraint testvolumetype]} { testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}] } testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] test winFile-1.1 {TclpGetUserHome} -constraints {win} -body { glob ~nosuchuser } -returnCodes error -result {user "nosuchuser" doesn't exist} test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body { # The administrator account should always exist. glob ~administrator |
︙ | ︙ |
Changes to tests/winNotify.test.
1 2 3 4 5 6 | # This file tests the tclWinNotify.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # This file tests the tclWinNotify.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testeventloop [expr {[info commands testeventloop] != {}}] # There is no explicit test for InitNotifier or NotifierExitHandler test winNotify-1.1 {Tcl_SetTimer: positive timeout} {win} { set done 0 |
︙ | ︙ |
Changes to tests/winPipe.test.
1 2 3 4 5 6 7 8 | # # winPipe.test -- # # This file contains a collection of tests for tclWinPipe.c # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output (except for one message) means no errors were found. # | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | # # winPipe.test -- # # This file contains a collection of tests for tclWinPipe.c # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output (except for one message) means no errors were found. # # Copyright © 1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } unset -nocomplain path catch { ::tcltest::loadTestedCommands package require -exact tcl::test [info patchlevel] set ::tcltestlib [info loaded {} Tcltest] } set org_pwd [pwd] set bindir [file join $org_pwd [file dirname [info nameofexecutable]]] set cat32 [file join $bindir cat32.exe] testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] # several test-cases here expect current directory == [temporaryDirectory]: cd [temporaryDirectory] testConstraint exec [llength [info commands exec]] testConstraint cat32 [file exists $cat32] |
︙ | ︙ | |||
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/winTime.test.
1 2 3 4 5 6 | # This file tests the tclWinTime.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # | | | | > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | # This file tests the tclWinTime.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright © 1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 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 testwinclock [llength [info commands testwinclock]] # 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)]}] # The next two tests will crash on Windows if the check for negative # clock values is not done properly. test winTime-1.1 {TclpGetDate} {win} { set ::env(TZ) JST-9 set result [clock format -1 -format %Y] |
︙ | ︙ | |||
37 38 39 40 41 42 43 | set result } {1969} # Next test tries to make sure that the Tcl clock stays in step # with the Windows clock. 30 sec really isn't enough, # but how much time does a tester have patience for? | | | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | set result } {1969} # Next test tries to make sure that the Tcl clock stays in step # with the Windows clock. 30 sec really isn't enough, # but how much time does a tester have patience for? test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock notInCIenv} { # May fail due to OS/hardware discrepancies. See: # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323 set failed {} set ok 1 foreach start_sec [testwinclock] break while { 1 } { foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break |
︙ | ︙ |
Changes to tests/zipfs.test.
1 2 3 4 5 6 | # The file tests the tclZlib.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | < < < < < | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 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 | # The file tests the tclZlib.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1996-1998 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint zipfs [expr { [llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]] }] testConstraint zipfslib 1 set ziproot [zipfs root] set CWD [pwd] set tmpdir [file join $CWD tmp] file mkdir $tmpdir test zipfs-0.0 {zipfs basics} -constraints zipfs -body { package require tcl::zipfs } -result {2.0} test zipfs-0.1 {zipfs basics} -constraints zipfs -body { expr {${ziproot} in [file volumes]} } -result 1 if {![string match ${ziproot}* $tcl_library]} { ### # "make test" does not map tcl_library from the dynamic library on Unix # # Hack the environment to pretend we did pull tcl_library from a zip # archive ### set tclzip [file join $CWD libtcl[info patchlevel].zip] testConstraint zipfslib [file isfile $tclzip] if {[testConstraint zipfslib]} { zipfs mount /lib/tcl $tclzip set ::tcl_library ${ziproot}lib/tcl/tcl_library } } |
︙ | ︙ | |||
271 272 273 274 275 276 277 | } -body { interp eval $safe { zipfs mkzip } } -returnCodes error -cleanup { interp delete $safe } -result {not allowed to invoke subcommand mkzip of zipfs} | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | } -body { interp eval $safe { 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 zipfs mount ziptest $targetImage try { list [glob -tails -directory //zipfs://ziptest/test *.tcl] \ [if {[file size $midImage] == [file size $targetImage]} { string cat equal } else { list mid=[file size $midImage] target=[file size $targetImage] }] } finally { zipfs unmount ziptest } } -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 zipfs lmkimg $targetImage [list $addFile test/ok.tcl] {} $midImage zipfs mount ziptest $targetImage try { glob -tails -directory //zipfs://ziptest/test *.tcl } finally { zipfs unmount ziptest } } -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 zipfs lmkimg $targetImage [list $addFile test/ok.tcl] $pass $midImage zipfs mount ziptest $targetImage try { glob -tails -directory //zipfs://ziptest/test *.tcl } finally { zipfs unmount ziptest } } -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 set f [glob -directory //zipfs://ziptest/test *.tcl] zipfs lmkimg $targetImage [list $f test/ok.tcl] {} $midImage zipfs unmount ziptest zipfs mount ziptest $targetImage list $f [glob -directory //zipfs://ziptest/test *.tcl] } -cleanup { zipfs unmount ziptest removeFile $baseImage removeFile $midImage removeFile $targetImage removeFile $addFile } -result {//zipfs://ziptest/test/add.tcl //zipfs://ziptest/test/ok.tcl} test zipfs-5.1 {zipfs mount_data: short data} -constraints zipfs -body { zipfs mount_data gorp {} } -returnCodes error -result {bad zip data} test zipfs-5.2 {zipfs mount_data: short data} -constraints zipfs -body { zipfs mount_data gorp gorpGORPgorp } -returnCodes error -result {bad zip data} test zipfs-5.3 {zipfs mount_data: short data} -constraints zipfs -body { set data PK\x03\x04..................................... append data PK\x01\x02..................................... append data PK\x05\x06..................................... zipfs mount_data gorp $data } -returnCodes error -result {bad zip data} test zipfs-5.4 {zipfs mount_data: bad arg count} -constraints zipfs -body { zipfs mount_data gorp {} foobar } -returnCodes error -result {wrong # args: should be "zipfs mount_data ?mountpoint? ?data?"} test zipfs-6.1 {zipfs mkkey} -constraints zipfs -body { binary scan [zipfs mkkey gorp] cu* x return $x } -result {224 226 111 103 4 80 75 90 90} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/zlib.test.
1 2 3 4 5 6 | # The file tests the tclZlib.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # The file tests the tclZlib.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1996-1998 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* |
︙ | ︙ | |||
30 31 32 33 34 35 36 | test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body { zlib ? {} } -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream} test zlib-1.3 {zlib basics} -constraints zlib -body { zlib::pkgconfig list } -result zlibVersion test zlib-1.4 {zlib basics} -constraints zlib -body { | | | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body { zlib ? {} } -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream} test zlib-1.3 {zlib basics} -constraints zlib -body { zlib::pkgconfig list } -result zlibVersion test zlib-1.4 {zlib basics} -constraints zlib -body { package present tcl::zlib } -result 2.0.1 test zlib-2.1 {zlib compress/decompress} zlib { zlib decompress [zlib compress abcdefghijklm] } abcdefghijklm test zlib-3.1 {zlib deflate/inflate} zlib { |
︙ | ︙ | |||
136 137 138 139 140 141 142 | set s [zlib stream deflate] $s put {} } -cleanup { catch {$s close} } -result "" # Also causes Tk Bug 10f2e7872b test zlib-7.8 {zlib stream: Bug b26e38a3e4} -constraints zlib -setup { | | | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 | set s [zlib stream deflate] $s put {} } -cleanup { catch {$s close} } -result "" # Also causes Tk Bug 10f2e7872b test zlib-7.8 {zlib stream: Bug b26e38a3e4} -constraints zlib -setup { expr {srand(12345)} set randdata {} for {set i 0} {$i<6001} {incr i} { append randdata [binary format c [expr {int(256*rand())}]] } } -body { set strm [zlib stream compress] for {set i 1} {$i<3000} {incr i} { |
︙ | ︙ | |||
447 448 449 450 451 452 453 | catch {close $inSide} catch {$strm close} } -result {358 358} test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup { # Actual data isn't very important; needs to be substantially larger than # the internal buffer (32kB) and incompressible. set largeData {} | | | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 | catch {close $inSide} catch {$strm close} } -result {358 358} test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup { # Actual data isn't very important; needs to be substantially larger than # the internal buffer (32kB) and incompressible. set largeData {} for {set i 0;expr {srand(1)}} {$i < 100000} {incr i} { append largeData [lindex "a b c d e f g h i j k l m n o p" \ [expr {int(16*rand())}]] } set file [makeFile {} test.gz] } -constraints zlib -body { set f [open $file wb] fconfigure $f -buffering none |
︙ | ︙ |
Deleted tools/Makefile.in.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to tools/README.
1 2 3 4 5 6 7 8 9 10 11 | This directory contains unsupported tools used to build parts of Tcl for distribution. uniParse.tcl -- Script for converting the Unicode character database into a compact table stored in generic/tclUniData.c. uniClass.tcl -- Script for generating regexp class tables from the Tcl "string is" classes Generating HTML files. | < < < < | < < < < < < < > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | This directory contains unsupported tools used to build parts of Tcl for distribution. uniParse.tcl -- Script for converting the Unicode character database into a compact table stored in generic/tclUniData.c. uniClass.tcl -- Script for generating regexp class tables from the Tcl "string is" classes Generating HTML files. This script is very picky about the organization of man pages, effectively acting as a style enforcer. The resulting documentation can be found at /tmp/dist/tcl<version>/html |
Added tools/addVerToFile.tcl.
> > > > > > > > > | 1 2 3 4 5 6 7 8 9 | #!/usr/bin/env tclsh if {$argc < 1} { error "need a filename argument" } lassign $argv filename set f [open $filename a] puts $f "TCL_VERSION=[info tclversion]" puts $f "TCL_PATCHLEVEL=[info patchlevel]" close $f |
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 (c) 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." |
︙ | ︙ |
Deleted tools/configure.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Deleted tools/configure.ac.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to tools/encoding/big5.txt.
1 2 3 4 | # big5.txt -- # # BIG5 to Unicode table (modified) # | | | 1 2 3 4 5 6 7 8 9 10 11 12 | # big5.txt -- # # BIG5 to Unicode table (modified) # # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # NOTE: this table has been modified to include the 7-bit ASCII # characters that are allowed in BIG5 files. # |
︙ | ︙ |
Changes to tools/encoding/gb2312.txt.
1 2 3 4 | # gb2312.txt -- # # GB2312 to Unicode table (modified) # | | | 1 2 3 4 5 6 7 8 9 10 11 12 | # gb2312.txt -- # # GB2312 to Unicode table (modified) # # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # NOTE: this table has been modified to include the 7-bit ASCII # characters that are allowed in GB2312 files. # |
︙ | ︙ |
Deleted tools/eolFix.tcl.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
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 | # genStubs.tcl -- # # This script generates a set of stub files for a given # interface. # # # Copyright (c) 1998-1999 Scriptics Corporation. # Copyright (c) 2007 Daniel A. Steffen <[email protected]> # # 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 -- |
︙ | ︙ | |||
253 254 255 256 257 258 259 260 | proc genStubs::rewriteFile {file text} { if {![file exists $file]} { puts stderr "Cannot find file: $file" return } set in [open ${file} r] set out [open ${file}.new w] | > | | 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 | proc genStubs::rewriteFile {file text} { if {![file exists $file]} { puts stderr "Cannot find file: $file" return } set in [open ${file} r] fconfigure $in -eofchar "\032 {}" -encoding utf-8 set out [open ${file}.new w] fconfigure $out -translation lf -encoding utf-8 while {![eof $in]} { set line [gets $in] if {[string match "*!BEGIN!*" $line]} { break } puts $out $line |
︙ | ︙ | |||
1096 1097 1098 1099 1100 1101 1102 | append text $sep "&${sub}Stubs" set sep ",\n " } append text "\n\};\n" } foreach intf [array names interfaces] { if {[info exists hooks($intf)]} { | | | 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 | append text $sep "&${sub}Stubs" set sep ",\n " } append text "\n\};\n" } foreach intf [array names interfaces] { if {[info exists hooks($intf)]} { if {$name in $hooks($intf)} { set root 0 break } } } append text "\n" |
︙ | ︙ | |||
1187 1188 1189 1190 1191 1192 1193 | puts stderr "usage: $argv0 outDir declFile ?declFile...?" exit 1 } set outDir [lindex $argv 0] foreach file [lrange $argv 1 end] { | | | 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 | puts stderr "usage: $argv0 outDir declFile ?declFile...?" exit 1 } set outDir [lindex $argv 0] foreach file [lrange $argv 1 end] { source -encoding utf-8 $file } foreach name [lsort [array names interfaces]] { puts "Emitting $name" emitHeader $name } |
︙ | ︙ | |||
1209 1210 1211 1212 1213 1214 1215 | # Arguments: # valueList A list containing the values to be assigned. # args The list of variables to be assigned. # # Results: # Returns any values that were not assigned to variables. | | | 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 | # Arguments: # valueList A list containing the values to be assigned. # args The list of variables to be assigned. # # Results: # Returns any values that were not assigned to variables. if {[namespace which lassign] ne ""} { proc lassign {valueList args} { if {[llength $args] == 0} { error "wrong # args: should be \"lassign list varName ?varName ...?\"" } uplevel [list foreach $args $valueList {break}] return [lrange $valueList [llength $args] end] } } genStubs::init |
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 (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # 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 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 | # # This file installs a hierarchy of data found in the directory # specified by its first argument into the directory specified # by its second. # #---------------------------------------------------------------------- # # Copyright (c) 2004 Kevin B. Kenny. All rights reserved. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- proc copyDir {d1 d2} { puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \ [file tail $d2]] file delete -force -- $d2 file mkdir $d2 foreach ftail [glob -directory $d1 -nocomplain -tails *] { set f [file join $d1 $ftail] if {[file isdirectory $f] && [string compare CVS $ftail]} { copyDir $f [file join $d2 $ftail] } elseif {[file isfile $f]} { file copy -force $f [file join $d2 $ftail] if {$::tcl_platform(platform) eq {unix}} { file attributes [file join $d2 $ftail] -permissions 0o644 } else { file attributes [file join $d2 $ftail] -readonly 1 } } } if {$::tcl_platform(platform) eq {unix}} { file attributes $d2 -permissions 0o755 } else { file attributes $d2 -readonly 1 } } copyDir [file normalize [lindex $argv 0]] [file normalize [lindex $argv 1]] |
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 (c) 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 (c) 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 6 7 8 9 10 | # makeHeader.tcl -- # # This script generates embeddable C source (in a .h file) from a .tcl # script. # # Copyright (c) 2018 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | # makeHeader.tcl -- # # This script generates embeddable C source (in a .h file) from a .tcl # script. # # Copyright (c) 2018 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.6- namespace eval makeHeader { #################################################################### # # mapSpecial -- # Transform a single line so that it is able to be put in a C string. # proc mapSpecial {str} { # All Tcl metacharacters and key C backslash sequences set MAP { \" \\\\\" \\ \\\\\\\\ $ \\$ [ \\[ ] \\] ' \\\\' ? \\\\? \a \\\\a \b \\\\b \f \\\\f \n \\\\n \r \\\\r \t \\\\t \v \\\\v } set XFORM {[format \\\\\\\\u%04x {*}[scan & %c]]} subst [regsub -all {[^\x20-\x7E]} [string map $MAP $str] $XFORM] } #################################################################### # # compactLeadingSpaces -- # Converts the leading whitespace on a line into a more compact form. # |
︙ | ︙ |
Deleted tools/man2help.tcl.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Deleted tools/man2help2.tcl.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Deleted tools/man2html.tcl.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Deleted tools/man2html1.tcl.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Deleted tools/man2html2.tcl.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Deleted tools/man2tcl.c.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to tools/mkVfs.tcl.
︙ | ︙ | |||
35 36 37 38 39 40 41 | foreach ftail [glob -directory $d1 -nocomplain -tails *] { set f [file join $d1 $ftail] if {[file isdirectory $f] && [string compare CVS $ftail]} { copyDir $f [file join $d2 $ftail] } elseif {[file isfile $f]} { file copy -force $f [file join $d2 $ftail] if {$::tcl_platform(platform) eq {unix}} { | | | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | foreach ftail [glob -directory $d1 -nocomplain -tails *] { set f [file join $d1 $ftail] if {[file isdirectory $f] && [string compare CVS $ftail]} { copyDir $f [file join $d2 $ftail] } elseif {[file isfile $f]} { file copy -force $f [file join $d2 $ftail] if {$::tcl_platform(platform) eq {unix}} { file attributes [file join $d2 $ftail] -permissions 0o644 } else { file attributes [file join $d2 $ftail] -readonly 1 } } } if {$::tcl_platform(platform) eq {unix}} { file attributes $d2 -permissions 0o755 } else { file attributes $d2 -readonly 1 } } if {[llength $argv] < 3} { puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM" |
︙ | ︙ |
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 (c) 1996 Sun Microsystems, Inc. proc readInputFile {} { global inFileName global lineArray set fileId [open $inFileName r] |
︙ | ︙ | |||
188 189 190 191 192 193 194 | regsub -all {E} $currentLine {\\033} currentLine regsub -all {F} $currentLine {\\f} currentLine regsub -all {N} $currentLine {\\n} currentLine # if and \r substitutions are made, do not wrap re, flags, # str, and result in braces | | | 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 | regsub -all {E} $currentLine {\\033} currentLine regsub -all {F} $currentLine {\\f} currentLine regsub -all {N} $currentLine {\\n} currentLine # if and \r substitutions are made, do not wrap re, flags, # str, and result in braces set noBraces [regsub -all {R} $currentLine {\\\x0D} currentLine] regsub -all {T} $currentLine {\\t} currentLine regsub -all {V} $currentLine {\\v} currentLine if {[regexp {=} $flags] == 1} { set re [lindex $currentLine 0] } set str [lindex $currentLine 2] } |
︙ | ︙ |
Deleted tools/str2c.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Deleted tools/tcl.hpj.in.
|
| < < < < < < < < < < < < < < < < < < < |
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 (c) 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. |
︙ | ︙ | |||
1259 1260 1261 1262 1263 1264 1265 | append data "\n " [list [list $time $offset $dst $name]] } append data \n # Write the data to the information file set f [open $fileName w] | | | 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 | append data "\n " [list [list $time $offset $dst $name]] } append data \n # Write the data to the information file set f [open $fileName w] fconfigure $f -translation lf -encoding utf-8 puts $f "\# created by $::argv0 - do not edit" puts $f "" puts $f [list set TZData(:$zoneName) $data] close $f } return |
︙ | ︙ | |||
1312 1313 1314 1315 1316 1317 1318 | set sourceCmd "\n [list LoadTimeZoneFile $linkTo]\n" set ifCmd [list if "!\[info exists TZData($linkTo)\]" $sourceCmd] set setCmd "set TZData(:$zoneName) \$TZData(:$linkTo)" # Write the file set f [open $fileName w] | | | 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 | set sourceCmd "\n [list LoadTimeZoneFile $linkTo]\n" set ifCmd [list if "!\[info exists TZData($linkTo)\]" $sourceCmd] set setCmd "set TZData(:$zoneName) \$TZData(:$linkTo)" # Write the file set f [open $fileName w] fconfigure $f -translation lf -encoding utf-8 puts $f "\# created by $::argv0 - do not edit" puts $f $ifCmd puts $f $setCmd close $f } return |
︙ | ︙ |
Changes to tools/tcltk-man2html-utils.tcl.
︙ | ︙ | |||
39 40 41 42 43 44 45 | ## ## templating ## proc indexfile {} { if {[info exists ::TARGET] && $::TARGET eq "devsite"} { return "index.tml" } else { | | | | | < < < < | | | | > > > > | | > > > > | > > > | > | | > > > > > > | > > > > > > > > > > > > | > > > > > > > > > | > > > > > > > > | > | > | | > | | | | | | 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 | ## ## templating ## proc indexfile {} { if {[info exists ::TARGET] && $::TARGET eq "devsite"} { return "index.tml" } else { return "index.html" } } proc copyright {copyright {level {}}} { # We don't actually generate a separate copyright page anymore #set page "${level}copyright.html" #return "<a href=\"$page\">Copyright</a> © [htmlize-text [lrange $copyright 2 end]]" # obfuscate any email addresses that may appear in name set who [string map {@ (at)} [lrange $copyright 2 end]] return "Copyright © [htmlize-text $who]" } proc copyout {copyrights {level {}}} { set count 0 set out "<div class=\"copy\">" foreach c $copyrights { if {$count > 0} { append out <br> } append out "[copyright $c $level]\n" incr count } append out "</div>" return $out } proc CSS {{level ""}} { return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n" } proc htmlhead {title header args} { set level "" if {[lindex $args end] eq "../[indexfile]"} { # XXX hack - assume same level for CSS file set level "../" } set out "<!DOCTYPE html>\n<html lang=\"en\">\n<head><meta charset=\"utf-8\"><title>$title</title>\n[CSS $level]</head>\n" foreach {uptitle url} $args { set header "<a href=\"$url\">$uptitle</a> <small>></small> $header" } append out "<body><h2>$header</h2>" global manual if {[info exists manual(subheader)]} { set subs {} foreach {name subdir} $manual(subheader) { if {$name eq $title} { lappend subs $name } else { lappend subs "<a href=\"${level}$subdir/[indexfile]\">$name</a>" } } append out "\n<h3>[join $subs { | }]</h3>" } return $out } ## ## parsing ## proc unquote arg { return [string map [list \" {}] $arg] } proc parse-directive {line codename restname} { upvar 1 $codename code $restname rest return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest] } proc nospace-text {text} { return [regsub -all " " $text _] } proc htmlize-text {text {charmap {}}} { # contains some extras for use in nroff->html processing # build on the list passed in, if any lappend charmap \ "–" "–" \ {&} {&} \ {\\} "\" \ {\e} "\" \ {\ } { } \ {\|} { } \ {\0} { } \ \" {"} \ {<} {<} \ {>} {>} \ \u201C "“" \ \u201D "”" return [string map $charmap $text] } proc process-text {text} { global manual # preprocess text; note that this is an incomplete map, and will probably # need to have things added to it as the manuals expand to use them. set charmap [list \ {\&} "\t" \ {\%} {} \ "\\\n" "\n" \ {\(r!} "¡" \ {\(ct} "¢" \ {\(Po} "£" \ {\(Cs} "¤" \ {\(Ye} "¥" \ {\(bb} "¦" \ {\(sc} "§" \ {\(ad} "¨" \ {\(co} "©" \ {\(Of} "ª" \ {\(Fo} "«" \ {\(no} "¬" \ {\(rg} "®" \ {\(a-} "¯" \ {\(de} "°" \ {\(+-} "±" \ {\(S2} "²" \ {\(S3} "³" \ {\(aa} "´" \ {\(mc} "µ" \ {\(ps} "¶" \ {\(pc} "·" \ {\(ac} "¸" \ {\(S1} "¹" \ {\(Om} "º" \ {\(Fc} "»" \ {\(14} "¼" \ {\(12} "½" \ {\(34} "¾" \ {\(r?} "¿" \ {\(AE} "Æ" \ {\(-D} "Ð" \ {\(mu} "×" \ {\(TP} "Þ" \ {\(ss} "ß" \ {\(ae} "æ" \ {\(Sd} "ð" \ {\(di} "÷" \ {\(Tp} "þ" \ {\(em} "—" \ {\(en} "–" \ {\(fm} "′" \ {\(mi} "−" \ {\(.i} "ı" \ {\(.j} "ȷ" \ {\(Fn} "ƒ" \ {\(OE} "Œ" \ {\(oe} "œ" \ {\(IJ} "IJ" \ {\(ij} "ij" \ {\(<-} "<font size=\"+1\">←</font>" \ {\(->} "<font size=\"+1\">→</font>" \ {\(eu} "€" \ {\fP} {\fR} \ {\.} . \ {\(bu} "•" \ {\*(qo} "ô" \ ] # This might make a few invalid mappings, but we don't use them foreach c {a c e g i l n o s t u y z A C E G I L N O S T U Y Z} { foreach {prefix suffix} { o ring / slash : uml ' acute ^ circ ` grave ~ tilde , cedil v caron } { lappend charmap "\\\[${prefix}${c}\]" "&${c}${suffix};" lappend charmap "\\(${prefix}${c}" "&${c}${suffix};" } } lappend charmap {\-\|\-} -- ; # two hyphens lappend charmap {\-} - ; # a hyphen set text [htmlize-text $text $charmap] # General quoted entity regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text while {[string first "\\" $text] >= 0} { # C R if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \ {\1<tt>\2</tt>\3} text]} continue # B R if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \ {\1<b>\2</b>\3} text]} continue # B I if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \ {\1<b>\2</b>\\fI\3} text]} continue # I R if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \ {\1<i>\2</i>\3} text]} continue # I B if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \ {\1<i>\2</i>\\fB\3} text]} continue # B B, I I, R R if { [regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \ {\1\\fB\2\3} ntext] || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \ {\1\\fI\2\3} ntext] || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \ |
︙ | ︙ | |||
322 323 324 325 326 327 328 | ## proc long-toc {text} { global manual set here M[incr manual(section-toc-n)] set manual($manual(name)-id-$text) $here set there L[incr manual(long-toc-n)] lappend manual(section-toc) \ | | | | 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 | ## proc long-toc {text} { global manual set here M[incr manual(section-toc-n)] set manual($manual(name)-id-$text) $here set there L[incr manual(long-toc-n)] lappend manual(section-toc) \ "<dd><a href=\"$manual(name).html#$here\" name=\"[nospace-text $there]\" id=\"[nospace-text $there]\">$text</a>" return "<a name=\"[nospace-text $here]\" id=\"[nospace-text $here]\">$text</a>" } proc option-toc {name class switch} { global manual # Special case handling, oh we hate it but must do it if {[string match "*OPTIONS" $manual(section)]} { if {$manual(name) ne "ttk_widget" && ($manual(name) ne "ttk_entry" || |
︙ | ︙ | |||
348 349 350 351 352 353 354 | # link the defined standard option to the long table of contents and make # a target for the standard option references from other man pages. set first [lindex $switch 0] set here M$first set there L[incr manual(long-toc-n)] set manual(standard-option-$manual(name)-$first) \ | | | | | | | | | | 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 | # link the defined standard option to the long table of contents and make # a target for the standard option references from other man pages. set first [lindex $switch 0] set here M$first set there L[incr manual(long-toc-n)] set manual(standard-option-$manual(name)-$first) \ "<a href=\"$manual(name).html#$here\">$switch, $name, $class</a>" lappend manual(section-toc) \ "<dd><a href=\"$manual(name).html#$here\" name=\"[nospace-text $there]\" id=\"[nospace-text $there]\">$switch, $name, $class</a>" return "<a name=\"[nospace-text $here]\" id=\"[nospace-text $here]\">$switch</a>" } proc std-option-toc {name page} { global manual if {[info exists manual(standard-option-$page-$name)]} { lappend manual(section-toc) <dd>$manual(standard-option-$page-$name) return $manual(standard-option-$page-$name) } manerror "missing reference to \"$name\" in $page.n" set here M[incr manual(section-toc-n)] set there L[incr manual(long-toc-n)] set other M$name lappend manual(section-toc) "<dd><a href=\"$page.html#$other\">$name</a>" return "<a href=\"$page.html#$other\">$name</a>" } ## ## process the widget option section ## in widget and options man pages ## proc output-widget-options {rest} { global manual man-puts <dl> lappend manual(section-toc) <dl> backup-text 1 set para {} while {[next-op-is .OP rest]} { switch -exact -- [llength $rest] { 3 { lassign $rest switch name class } |
︙ | ︙ | |||
406 407 408 409 410 411 412 | } if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} { error "not Name: $name" } if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} { error "not Class: $class" } | | | | | | | 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 | } if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} { error "not Name: $name" } if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} { error "not Class: $class" } man-puts "$para<dt>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch" man-puts "<dt>Database Name: $oname$name$cname" man-puts "<dt>Database Class: $oclass$class$cclass" man-puts <dd>[next-text] set para <p> if {[next-op-is .RS rest]} { while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest switch -exact -- $code { |
︙ | ︙ | |||
436 437 438 439 440 441 442 | } } else { man-puts $line } } } } | | | | | | | 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 | } } else { man-puts $line } } } } man-puts </dl> lappend manual(section-toc) </dl> } ## ## process .RS lists ## proc output-RS-list {} { global manual if {[next-op-is .IP rest]} { output-IP-list .RS .IP $rest if {[match-text .RE .sp .RS @rest .IP @rest2]} { man-puts <p>$rest output-IP-list .RS .IP $rest2 } if {[match-text .RE .sp .RS @rest .RE]} { man-puts <p>$rest return } if {[next-op-is .RE rest]} { return } } man-puts <dl><dd> while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest switch -exact -- $code { .RE { break |
︙ | ︙ | |||
481 482 483 484 485 486 487 | output-directive $line } } } else { man-puts $line } } | | | | | | | | | | | | | | | | | | | | 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 | output-directive $line } } } else { man-puts $line } } man-puts </dl> } ## ## process .IP lists which may be plain indents, ## numeric lists, or definition lists ## proc output-IP-list {context code rest} { global manual if {![string length $rest]} { # blank label, plain indent, no contents entry man-puts <dl><dd> while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest if {$code eq ".IP" && $rest eq {}} { man-puts "<p>" continue } if {$code in {.br .DS .RS}} { output-directive $line } else { backup-text 1 break } } else { man-puts $line } } man-puts </dl> } else { # labelled list, make contents if {$context ne ".SH" && $context ne ".SS"} { man-puts <p> } set dl "<dl class=\"[string tolower $manual(section)]\">" set enddl "</dl>" if {$code eq ".IP"} { if {[regexp {^\[[\da-f]+\]|\(?[\da-f]+\)$} $rest]} { set dl "<ol class=\"[string tolower $manual(section)]\">" set enddl "</ol>" } elseif {"•" eq $rest} { set dl "<ul class=\"[string tolower $manual(section)]\">" set enddl "</ul>" } } man-puts $dl lappend manual(section-toc) $dl backup-text 1 set accept_RE 0 set para {} while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest switch -exact -- $code { .IP { if {$accept_RE} { output-IP-list .IP $code $rest continue } if {$manual(section) eq "ARGUMENTS"} { man-puts "$para<dt>$rest<dd>" } elseif {[regexp {^\[([\da-f]+)\]$} $rest -> value]} { man-puts "$para<li value=\"$value\">" } elseif {[regexp {^\(?([\da-f]+)\)$} $rest -> value]} { man-puts "$para<li value=\"$value\">" } elseif {"•" eq $rest} { man-puts "$para<li>" } else { man-puts "$para<dt>[long-toc $rest]<dd>" } } .sp - .br - .DS - .CS { output-directive $line } .RS { if {[match-text .RS]} { |
︙ | ︙ | |||
578 579 580 581 582 583 584 | } else { output-directive $line } } .PP { if {[match-text @rest1 .br @rest2 .RS]} { # yet another nroff kludge as above | | | | | | 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 | } else { output-directive $line } } .PP { if {[match-text @rest1 .br @rest2 .RS]} { # yet another nroff kludge as above man-puts "$para<dt>[long-toc $rest1]" man-puts "<dt>[long-toc $rest2]<dd>" incr accept_RE 1 } elseif {[match-text @rest .RE]} { # gad, this is getting ridiculous if {!$accept_RE} { man-puts "$enddl<p>$rest$dl" backup-text 1 set para {} break } man-puts "<p>$rest" incr accept_RE -1 } elseif {$accept_RE} { output-directive $line } else { backup-text 1 break } |
︙ | ︙ | |||
613 614 615 616 617 618 619 | backup-text 1 break } } } else { man-puts $line } | | | 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 | backup-text 1 break } } } else { man-puts $line } set para <p> } man-puts "$para$enddl" lappend manual(section-toc) $enddl if {$accept_RE} { manerror "missing .RE in output-IP-list" } } |
︙ | ︙ | |||
636 637 638 639 640 641 642 | proc output-name {line} { global manual # split name line into pieces regexp {^([^-]+) - (.*)$} [regsub -all {[ \n\r\t]+} $line " "] -> head tail # output line to manual page untouched man-puts "$head — $tail" # output line to long table of contents | | | | 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 | proc output-name {line} { global manual # split name line into pieces regexp {^([^-]+) - (.*)$} [regsub -all {[ \n\r\t]+} $line " "] -> head tail # output line to manual page untouched man-puts "$head — $tail" # output line to long table of contents lappend manual(section-toc) "<dl><dd>$head — $tail</dd></dl>" # separate out the names for future reference foreach name [split $head ,] { set name [string trim $name] if {[llength $name] > 1} { manerror "name has a space: {$name}\nfrom: $line" } lappend manual(wing-toc) $name lappend manual(name-$name) $manual(wing-file)/$manual(name) } set manual(tooltip-$manual(wing-file)/$manual(name).html) $line } ## ## build a cross-reference link if appropriate ## proc cross-reference {ref} { global manual remap_link_target |
︙ | ︙ | |||
671 672 673 674 675 676 677 | } } elseif {$ref eq "Tcl"} { set lref $ref } elseif { [regexp {^[A-Z0-9 ?!]+$} $ref] && [info exists manual($manname-id-$ref)] } { | | | 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 | } } elseif {$ref eq "Tcl"} { set lref $ref } elseif { [regexp {^[A-Z0-9 ?!]+$} $ref] && [info exists manual($manname-id-$ref)] } { return "<a href=\"#$manual($manname-id-$ref)\">$ref</a>" } else { set lref [string tolower $ref] ## ## apply a link remapping if available ## if {[info exists remap_link_target($lref)]} { set lref $remap_link_target($lref) |
︙ | ︙ | |||
693 694 695 696 697 698 699 | if { [regexp "^$name \[a-z0-9]*\$" $lref] && [info exists manual(name-$name)] && $mantail ne "$name.n" && (![info exists exclude_refs_map($mantail)] || $manual(name-$name) ni $exclude_refs_map($mantail)) } { | | | 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 | if { [regexp "^$name \[a-z0-9]*\$" $lref] && [info exists manual(name-$name)] && $mantail ne "$name.n" && (![info exists exclude_refs_map($mantail)] || $manual(name-$name) ni $exclude_refs_map($mantail)) } { return "<a href=\"../$manual(name-$name).html\">$ref</a>" } } if {$lref in {end}} { # no good place to send this tcl token? } return $ref } |
︙ | ︙ | |||
718 719 720 721 722 723 724 | ## multiple choices for reference ## if {[llength $manref] > 1} { set tcl_i [lsearch -glob $manref *TclCmd*] if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd" || $manual(wing-file) eq "TclLib"} { set tcl_ref [lindex $manref $tcl_i] | | | | | 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 | ## multiple choices for reference ## if {[llength $manref] > 1} { set tcl_i [lsearch -glob $manref *TclCmd*] if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd" || $manual(wing-file) eq "TclLib"} { set tcl_ref [lindex $manref $tcl_i] return "<a href=\"../$tcl_ref.html\">$ref</a>" } set tk_i [lsearch -glob $manref *TkCmd*] if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd" || $manual(wing-file) eq "TkLib"} { set tk_ref [lindex $manref $tk_i] return "<a href=\"../$tk_ref.html\">$ref</a>" } if {$lref eq "exit" && $mantail eq "tclsh.1" && $tcl_i >= 0} { set tcl_ref [lindex $manref $tcl_i] return "<a href=\"../$tcl_ref.html\">$ref</a>" } puts stderr "multiple cross reference to $ref in $manref from $manual(wing-file)/$mantail" return $ref } ## ## exceptions, sigh, to the rule ## |
︙ | ︙ | |||
755 756 757 758 759 760 761 | && $lref in $exclude_refs_map($mantail) } { return $ref } ## ## return the cross reference ## | | | 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 | && $lref in $exclude_refs_map($mantail) } { return $ref } ## ## return the cross reference ## return "<a href=\"../$manref.html\">$ref</a>" } ## ## reference generation errors ## proc reference-error {msg text} { global manual |
︙ | ︙ | |||
778 779 780 781 782 783 784 | global manual set result "" while 1 { ## ## we identify cross references by: ## ``quotation'' | | | | | 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 | global manual set result "" while 1 { ## ## we identify cross references by: ## ``quotation'' ## <b>emboldening</b> ## Tcl_ prefix ## Tk_ prefix ## [a-zA-Z0-9]+ manual entry ## and we avoid messing with already anchored text ## ## ## find where each item lives - EXPENSIVE - and accumulate a list ## unset -nocomplain offsets foreach {name pattern} { anchor {<a } end-anchor {</a>} quote {``} end-quote {''} bold {<b>} end-bold {</b>} c.tcl {Tcl_} c.tk {Tk_} c.ttk {Ttk_} c.tdbc {Tdbc_} c.itcl {Itcl_} Tcl1 {Tcl manual entry} Tcl2 {Tcl overview manual entry} |
︙ | ︙ | |||
872 873 874 875 876 877 878 | url - end-bold { 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] | | | | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 | url - end-bold { 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 } anchor { append result \ [string range $text 0 [expr {$offset(end-bold)+3}]] set text [string range $text[set text ""] \ [expr {$offset(end-bold)+4}] end] |
︙ | ︙ | |||
910 911 912 913 914 915 916 | continue } url { set off [lindex $offsets 0] append result [string range $text 0 [expr {$off-1}]] regexp -indices -start $off {http://[\w/.-]+} $text range set url [string range $text {*}$range] | | | | | | | | | | | | | | | | 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 | continue } url { set off [lindex $offsets 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 } end-anchor - end-bold - end-quote { return [reference-error "Out of place $invert([lindex $offsets 0])" $text] } } } } ## ## process formatting directives ## proc output-directive {line} { global manual # process format directive split-directive $line code rest switch -exact -- $code { .BS - .BE { # man-puts <hr> } .SH - .SS { # drain any open lists # announce the subject set manual(section) $rest # start our own stack of stuff set manual($manual(name)-$manual(section)) {} lappend manual(has-$manual(section)) $manual(name) if {$code ne ".SS"} { man-puts "<h3>[long-toc $manual(section)]</h3>" } else { man-puts "<h4>[long-toc $manual(section)]</h4>" } # some sections can simply free wheel their way through the text # some sections can be processed in their own loops switch -exact -- [string index $code end]:$manual(section) { H:NAME { set names {} while {1} { set line [next-text] if {[is-a-directive $line]} { backup-text 1 if {[llength $names]} { output-name [join $names { }] } return } lappend names [string trim $line] } } H:SYNOPSIS { lappend manual(section-toc) <dl> while {1} { if { [next-op-is .nf rest] || [next-op-is .br rest] || [next-op-is .fi rest] } { continue } if { [next-op-is .SH rest] || [next-op-is .SS rest] || [next-op-is .BE rest] || [next-op-is .SO rest] } { backup-text 1 break } if {[next-op-is .sp rest]} { #man-puts <p> continue } set more [next-text] if {[is-a-directive $more]} { manerror "in SYNOPSIS found $more" backup-text 1 break } foreach more [split $more \n] { regexp {^(\s*)(.*)} $more -> spaces more set spaces [string map {" " " "} $spaces] if {[string length $spaces]} { set spaces <tt>$spaces</tt> } man-puts $spaces$more<br> if {$manual(wing-file) in {TclLib TkLib}} { lappend manual(section-toc) <dd>$more } } } lappend manual(section-toc) </dl> return } {H:SEE ALSO} { while {[more-text]} { if {[next-op-is .SH rest] || [next-op-is .SS rest]} { backup-text 1 return } set more [next-text] if {[is-a-directive $more]} { manerror "$more" backup-text 1 return } set nmore {} foreach cr [split $more ,] { set cr [string trim $cr] if {![regexp {^<b>.*</b>$} $cr]} { set cr <b>$cr</b> } if {[regexp {^<b>(.*)\([13n]\)</b>$} $cr all name]} { set cr <b>$name</b> } lappend nmore $cr } man-puts [join $nmore {, }] } return } |
︙ | ︙ | |||
1049 1050 1051 1052 1053 1054 1055 | backup-text 1 return } set keys {} foreach key [split $more ,] { set key [string trim $key] lappend manual(keyword-$key) [list $manual(name) \ | | | | 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 | backup-text 1 return } set keys {} foreach key [split $more ,] { set key [string trim $key] lappend manual(keyword-$key) [list $manual(name) \ $manual(wing-file)/$manual(name).html] set initial [string toupper [string index $key 0]] lappend keys "<a href=\"../Keywords/$initial.html\#$key\">$key</a>" } man-puts [join $keys {, }] } return } } if {[next-op-is .IP rest]} { |
︙ | ︙ | |||
1083 1084 1085 1086 1087 1088 1089 | manerror "unexpected .SO format:\n[expand-next-text 2]" } if {![next-op-is .SO rest]} { break } } output-directive {.SH STANDARD OPTIONS} | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 | manerror "unexpected .SO format:\n[expand-next-text 2]" } if {![next-op-is .SO rest]} { break } } output-directive {.SH STANDARD OPTIONS} man-puts <dl> lappend manual(section-toc) <dl> foreach optionpair [lsort -dictionary -index 0 $optslist] { lassign $optionpair option targetPage man-puts "<dt><b>[std-option-toc $option $targetPage]</b>" } man-puts </dl> lappend manual(section-toc) </dl> } .OP { output-widget-options $rest return } .IP { output-IP-list .IP .IP $rest return } .PP - .sp { man-puts <p> } .RS { output-RS-list return } .br { man-puts <br> return } .DS { if {[next-op-is .ta rest]} { # skip the leading .ta directive if it is there } if {[match-text @stuff .DE]} { set td "<td><p class=\"tablecell\">" set bodyText [string map [list \n <tr>$td \t $td] \n$stuff] man-puts "<dl><dd><table border=\"0\">$bodyText</table></dl>" #man-puts <pre>$stuff</pre> } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} { man-puts "<pre>[lindex $ul1 1][lindex $ul2 1]\n$stuff</pre>" } else { manerror "unexpected .DS format:\n[expand-next-text 2]" } return } .CS { if {[next-op-is .ta rest]} { # ??? } if {[match-text @stuff .CE]} { man-puts <pre>$stuff</pre> } else { manerror "unexpected .CS format:\n[expand-next-text 2]" } return } .nf { if {[match-text @more .fi]} { foreach more [split $more \n] { man-puts $more<br> } } elseif {[match-text .RS @more .RE .fi]} { man-puts <dl><dd> foreach more [split $more \n] { man-puts $more<br> } man-puts </dl> } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} { man-puts <dl><dd> foreach more [split $more \n] { man-puts $more<br> } man-puts <dl><dd> foreach more2 [split $more2 \n] { man-puts $more2<br> } man-puts </dl></dl> } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} { man-puts <dl><dd> foreach more [split $more \n] { man-puts $more<br> } man-puts <dl><dd> foreach more2 [split $more2 \n] { man-puts $more2<br> } man-puts </dl><dd> foreach more3 [split $more3 \n] { man-puts $more3<br> } man-puts </dl> } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} { man-puts <p><dl><dd> foreach more [split $more \n] { man-puts $more<br> } man-puts <dl><dd> foreach more2 [split $more2 \n] { man-puts $more2<br> } man-puts </dl></dl><p> } elseif {[match-text .RS .sp @more .sp .RE .fi]} { man-puts <p><dl><dd> foreach more [split $more \n] { man-puts $more<br> } man-puts </dl><p> } else { manerror "ignoring $line" } } .RE - .DE - .CE { manerror "unexpected $code" return |
︙ | ︙ | |||
1253 1254 1255 1256 1257 1258 1259 | ## sectionDescriptor, convert manpages into hypertext in ## the directory specified by outputDir. ## proc make-manpage-section {outputDir sectionDescriptor} { global manual overall_title tcltkdesc verbose global excluded_pages forced_index_pages process_first_patterns | | | > | | | 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 | ## sectionDescriptor, convert manpages into hypertext in ## the directory specified by outputDir. ## proc make-manpage-section {outputDir sectionDescriptor} { global manual overall_title tcltkdesc verbose global excluded_pages forced_index_pages process_first_patterns set LQ \u201C set RQ \u201D lassign $sectionDescriptor \ manual(wing-glob) \ manual(wing-name) \ manual(wing-file) \ manual(wing-description) set manual(wing-copyrights) {} makedirhier $outputDir/$manual(wing-file) set manual(wing-toc-fp) [open $outputDir/$manual(wing-file)/[indexfile] w] fconfigure $manual(wing-toc-fp) -translation lf -encoding utf-8 # whistle puts stderr "scanning section $manual(wing-name)" # put the entry for this section into the short table of contents if {[regexp {^(.+), version (.+)$} $manual(wing-name) -> name version]} { puts $manual(short-toc-fp) "<dt><a href=\"$manual(wing-file)/[indexfile]\" title=\"version $version\">$name</a></dt><dd>$manual(wing-description)</dd>" } else { puts $manual(short-toc-fp) "<dt><a href=\"$manual(wing-file)/[indexfile]\">$manual(wing-name)</a></dt><dd>$manual(wing-description)</dd>" } # initialize the wing table of contents puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \ $manual(wing-name) $overall_title "../[indexfile]"] # initialize the short table of contents for this section set manual(wing-toc) {} # initialize the man directory for this section |
︙ | ︙ | |||
1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 | if {!$verbose} { puts stderr "" } manerror "discarding $manual(name)" continue } set manual(infp) [open $manual(page)] set manual(text) {} set manual(partial-text) {} foreach p {.RS .DS .CS .SO} { set manual($p) 0 } set manual(stack) {} set manual(section) {} | > | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 | if {!$verbose} { puts stderr "" } manerror "discarding $manual(name)" continue } set manual(infp) [open $manual(page)] fconfigure $manual(infp) -encoding utf-8 set manual(text) {} set manual(partial-text) {} foreach p {.RS .DS .CS .SO} { set manual($p) 0 } set manual(stack) {} set manual(section) {} |
︙ | ︙ | |||
1556 1557 1558 1559 1560 1561 1562 | set manual(wing-copyrights) [merge-copyrights \ $manual(wing-copyrights) $manual(copyrights)] } # # make the long table of contents for this page # set manual(toc-$manual(wing-file)-$manual(name)) \ | | | 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 | set manual(wing-copyrights) [merge-copyrights \ $manual(wing-copyrights) $manual(copyrights)] } # # make the long table of contents for this page # set manual(toc-$manual(wing-file)-$manual(name)) \ [concat <dl> $manual(section-toc) </dl>] } if {!$verbose} { puts stderr "" } if {![llength $manual(wing-toc)]} { fatal "not table of contents." |
︙ | ︙ | |||
1586 1587 1588 1589 1590 1591 1592 | foreach name [lsort -dictionary $manual(wing-toc)] { set tail $manual(name-$name) if {[llength $tail] > 1} { manerror "$name is defined in more than one file: $tail" set tail [lindex $tail [expr {[llength $tail]-1}]] } set tail [file tail $tail] | | | | | | | 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 | foreach name [lsort -dictionary $manual(wing-toc)] { set tail $manual(name-$name) if {[llength $tail] > 1} { manerror "$name is defined in more than one file: $tail" set tail [lindex $tail [expr {[llength $tail]-1}]] } set tail [file tail $tail] if {[info exists manual(tooltip-$manual(wing-file)/$tail.html)]} { set tooltip $manual(tooltip-$manual(wing-file)/$tail.html) set tooltip [string map {[ {\[} ] {\]} $ {\$} \\ \\\\} $tooltip] regsub {^[^-]+-\s*(.)} $tooltip {[string totitle \1]} tooltip append rows([expr {$n%$nrows}]) \ "<td> <a href=\"$tail.html\" title=\"[subst $tooltip]\">$name</a> </td>" } else { append rows([expr {$n%$nrows}]) \ "<td> <a href=\"$tail.html\">$name</a> </td>" } incr n } puts $manual(wing-toc-fp) <table> foreach row [lsort -integer [array names rows]] { puts $manual(wing-toc-fp) <tr>$rows($row)</tr> } puts $manual(wing-toc-fp) </table> # # insert wing copyrights # puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"] puts $manual(wing-toc-fp) "</body></html>" close $manual(wing-toc-fp) set manual(merge-copyrights) \ [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)] } proc makedirhier {dir} { try { |
︙ | ︙ |
Changes to tools/tcltk-man2html.tcl.
1 2 3 4 5 6 | #!/usr/bin/env tclsh if {[catch {package require Tcl 8.6-} msg]} { puts stderr "ERROR: $msg" puts stderr "If running this script from 'make html', set the\ NATIVE_TCLSH environment\nvariable to point to an installed\ | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | #!/usr/bin/env tclsh if {[catch {package require Tcl 8.6-} msg]} { puts stderr "ERROR: $msg" puts stderr "If running this script from 'make html', set the\ NATIVE_TCLSH environment\nvariable to point to an installed\ tclsh8.6 (or the equivalent tclsh86.exe\non Windows)." exit 1 } # Convert Ousterhout format man pages into highly crosslinked hypertext. # # Along the way detect many unmatched font changes and other odd things. # |
︙ | ︙ | |||
63 64 65 66 67 68 69 | set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /] set v [getversion $tclh $upper] if {[llength $v]} { lassign $v major minor # to do # use glob matching instead of string matching or add # brace handling to [string matcch] | | | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /] set v [getversion $tclh $upper] if {[llength $v]} { lassign $v major minor # to do # use glob matching instead of string matching or add # brace handling to [string matcch] if {$useversion eq "" || [string match $useversion $major.$minor]} { set top [file dirname [file dirname $tclh]] set prefix [file dirname $top] return [list $prefix [file tail $top] $major $minor] } } } } |
︙ | ︙ | |||
168 169 170 171 172 173 174 | set major "" set minor "" if {$build_tcl} { # Find Tcl (firstly using glob pattern / backwards compatible way) set tcldir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tcl$useversion]] end] | | | | | | | | | 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 | set major "" set minor "" if {$build_tcl} { # Find Tcl (firstly using glob pattern / backwards compatible way) set tcldir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tcl$useversion]] end] if {$tcldir ne ""} { # obtain version from generic header if we can: lassign [getversion [file join $tcltkdir $tcldir generic tcl.h]] major minor } else { lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor } if {$tcldir eq "" && $opt_build_tcl} { puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" exit 1 } puts "using Tcl source directory [file join $tcltkdir $tcldir]" } if {$build_tk} { # Find Tk (firstly using glob pattern / backwards compatible way) set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tk$useversion]] end] if {$tkdir ne ""} { if {$major eq ""} { # obtain version from generic header if we can: lassign [getversion [file join $tcltkdir $tkdir generic tk.h]] major minor } } else { lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor } if {$tkdir eq "" && $opt_build_tk} { puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" exit 1 } puts "using Tk source directory [file join $tcltkdir $tkdir]" } puts "verbose messages are [expr {$verbose ? {on} : {off}}]" # the title for the man pages overall global overall_title set overall_title "" |
︙ | ︙ | |||
236 237 238 239 240 241 242 | proc css-style args { upvar 1 style style set body [uplevel 1 [list subst [lindex $args end]]] set tokens [join [lrange $args 0 end-1] ", "] append style $tokens " \{" $body "\}\n" } proc css-stylesheet {} { | | | | | | | | | | | 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 | proc css-style args { upvar 1 style style set body [uplevel 1 [list subst [lindex $args end]]] set tokens [join [lrange $args 0 end-1] ", "] append style $tokens " \{" $body "\}\n" } proc css-stylesheet {} { set hBd "1px dotted #11577B" css-style body div p th td li dd ul ol dl dt blockquote { font-family: Verdana, sans-serif; } css-style pre code { font-family: 'Courier New', Courier, monospace; } css-style pre { background-color: #F6FCEC; border-top: 1px solid #6A6A6A; border-bottom: 1px solid #6A6A6A; padding: 1em; overflow: auto; } css-style body { background-color: #FFFFFF; font-size: 12px; line-height: 1.25; letter-spacing: .2px; padding-left: .5em; } css-style h1 h2 h3 h4 { font-family: Georgia, serif; padding-left: 1em; margin-top: 1em; } css-style h1 { font-size: 18px; color: #11577B; border-bottom: $hBd; margin-top: 0px; } css-style h2 { font-size: 14px; color: #11577B; background-color: #C5DCE8; padding-left: 1em; border: 1px solid #6A6A6A; } css-style h3 h4 { color: #1674A4; background-color: #E8F2F6; border-bottom: $hBd; border-top: $hBd; } css-style h3 { font-size: 12px; } css-style h4 { font-size: 11px; } css-style ".keylist dt" ".arguments dt" { width: 20em; float: left; padding: 2px; border-top: 1px solid #999999; } css-style ".keylist dt" { font-weight: bold; } css-style ".keylist dd" ".arguments dd" { margin-left: 20em; padding: 2px; border-top: 1px solid #999999; } css-style .copy { background-color: #F6FCFC; white-space: pre; font-size: 80%; border-top: 1px solid #6A6A6A; margin-top: 2em; } css-style .tablecell { font-size: 12px; |
︙ | ︙ | |||
325 326 327 328 329 330 331 332 333 334 335 336 | ## proc make-man-pages {html args} { global manual overall_title tcltkdesc verbose global excluded_pages forced_index_pages process_first_patterns makedirhier $html set cssfd [open $html/$::CSSFILE w] puts $cssfd [css-stylesheet] close $cssfd set manual(short-toc-n) 1 set manual(short-toc-fp) [open $html/[indexfile] w] puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title] | > > | | 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 | ## proc make-man-pages {html args} { global manual overall_title tcltkdesc verbose global excluded_pages forced_index_pages process_first_patterns makedirhier $html set cssfd [open $html/$::CSSFILE w] fconfigure $cssfd -translation lf -encoding utf-8 puts $cssfd [css-stylesheet] close $cssfd set manual(short-toc-n) 1 set manual(short-toc-fp) [open $html/[indexfile] w] fconfigure $manual(short-toc-fp) -translation lf -encoding utf-8 puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title] puts $manual(short-toc-fp) "<dl class=\"keylist\">" set manual(merge-copyrights) {} foreach arg $args { # preprocess to set up subheader for the rest of the files if {![llength $arg]} { continue } |
︙ | ︙ | |||
366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 | ## if {!$verbose} { puts stderr "Assembling index" } file delete -force -- $html/Keywords makedirhier $html/Keywords set keyfp [open $html/Keywords/[indexfile] w] puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \ $overall_title "../[indexfile]"] set letters {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} # Create header first set keyheader {} foreach a $letters { set keys [array names manual "keyword-\[[string totitle $a$a]\]*"] if {[llength $keys]} { | > | | | > | | | | | | | | | | | | | 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 | ## if {!$verbose} { puts stderr "Assembling index" } file delete -force -- $html/Keywords makedirhier $html/Keywords set keyfp [open $html/Keywords/[indexfile] w] fconfigure $keyfp -translation lf -encoding utf-8 puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \ $overall_title "../[indexfile]"] set letters {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} # Create header first set keyheader {} foreach a $letters { set keys [array names manual "keyword-\[[string totitle $a$a]\]*"] if {[llength $keys]} { lappend keyheader "<a href=\"$a.html\">$a</a>" } else { # No keywords for this letter lappend keyheader $a } } set keyheader <h3>[join $keyheader " |\n"]</h3> puts $keyfp $keyheader foreach a $letters { set keys [array names manual "keyword-\[[string totitle $a$a]\]*"] if {![llength $keys]} { continue } # Per-keyword page set afp [open $html/Keywords/$a.html w] fconfigure $afp -translation lf -encoding utf-8 puts $afp [htmlhead "$tcltkdesc Keywords - $a" \ "$tcltkdesc Keywords - $a" \ $overall_title "../[indexfile]"] puts $afp $keyheader puts $afp "<dl class=\"keylist\">" foreach k [lsort -dictionary $keys] { set k [string range $k 8 end] puts $afp "<dt><a name=\"[nospace-text $k]\" id=\"[nospace-text $k]\">$k</a></dt>" puts $afp "<dd>" set refs {} foreach man $manual(keyword-$k) { set name [lindex $man 0] set file [lindex $man 1] if {[info exists manual(tooltip-$file)]} { set tooltip $manual(tooltip-$file) if {[string match {*[<>""]*} $tooltip]} { manerror "bad tooltip for $file: \"$tooltip\"" } lappend refs "<a href=\"../$file\" title=\"$tooltip\">$name</a>" } else { lappend refs "<a href=\"../$file\">$name</a>" } } puts $afp "[join $refs {, }]</dd>" } puts $afp "</dl>" # insert merged copyrights puts $afp [copyout $manual(merge-copyrights)] puts $afp "</body></html>" close $afp } # insert merged copyrights puts $keyfp [copyout $manual(merge-copyrights)] puts $keyfp "</body></html>" close $keyfp ## ## finish off short table of contents ## puts $manual(short-toc-fp) "<dt><a href=\"Keywords/[indexfile]\">Keywords</a><dd>The keywords from the $tcltkdesc man pages." puts $manual(short-toc-fp) "</dl>" # insert merged copyrights puts $manual(short-toc-fp) [copyout $manual(merge-copyrights)] puts $manual(short-toc-fp) "</body></html>" close $manual(short-toc-fp) ## ## output man pages ## unset manual(section) if {!$verbose} { |
︙ | ︙ | |||
464 465 466 467 468 469 470 | incr ntoc } if {$verbose} { puts stderr "rescanning page $manual(name) $ntoc/$ntext" } else { puts -nonewline stderr . } | | > | | 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 | incr ntoc } if {$verbose} { puts stderr "rescanning page $manual(name) $ntoc/$ntext" } else { puts -nonewline stderr . } set outfd [open $html/$manual(wing-file)/$manual(name).html w] fconfigure $outfd -translation lf -encoding utf-8 puts $outfd [htmlhead "$manual($manual(wing-file)-$manual(name)-title)" \ $manual(name) $wing_name "[indexfile]" \ $overall_title "../[indexfile]"] if {($ntext > 60) && ($ntoc > 32)} { foreach item $toc { puts $outfd $item } } elseif {$manual(name) in $forced_index_pages} { if {!$verbose} {puts stderr ""} manerror "forcing index generation" foreach item $toc { puts $outfd $item } } foreach item $text { puts $outfd [insert-cross-references $item] } puts $outfd "</body></html>" } on error msg { if {$verbose} { puts stderr $msg } else { puts stderr "\nError when processing $manual(name): $msg" } } finally { |
︙ | ︙ | |||
507 508 509 510 511 512 513 514 515 516 517 518 519 520 | ## Helper for assembling the descriptions of base packages (i.e., Tcl and Tk). ## proc plus-base {var root glob name dir desc} { global tcltkdir if {$var} { if {[file exists $tcltkdir/$root/README]} { set f [open $tcltkdir/$root/README] set d [read $f] close $f if {[regexp {This is the \w+ (\S+) source distribution} $d -> version]} { append name ", version $version" } } set glob $root/$glob | > | 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 | ## Helper for assembling the descriptions of base packages (i.e., Tcl and Tk). ## proc plus-base {var root glob name dir desc} { global tcltkdir if {$var} { if {[file exists $tcltkdir/$root/README]} { set f [open $tcltkdir/$root/README] fconfigure $f -encoding utf-8 set d [read $f] close $f if {[regexp {This is the \w+ (\S+) source distribution} $d -> version]} { append name ", version $version" } } set glob $root/$glob |
︙ | ︙ | |||
737 738 739 740 741 742 743 | if {2 != [llength $description]} { regexp {([^0-9]*)(.*)} $dir -> n v set description [list $n $v] } # ... but try to extract (name, version) from subdir contents try { | > > > | > > | 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 | if {2 != [llength $description]} { regexp {([^0-9]*)(.*)} $dir -> n v set description [list $n $v] } # ... but try to extract (name, version) from subdir contents try { try { set f [open [file join $pkgsDir $dir configure.in]] } trap {POSIX ENOENT} {} { set f [open [file join $pkgsDir $dir configure.ac]] } fconfigure $f -encoding utf-8 foreach line [split [read $f] \n] { if {2 == [scan $line \ { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} { set description [list $n $v] break } } |
︙ | ︙ | |||
762 763 764 765 766 767 768 769 770 771 772 773 774 775 | # Get the list of packages to try, and what their human-readable names # are. Note that the package directory list should be version-less. try { set packageDirNameMap {} if {$build_tcl} { set f [open $tcltkdir/$tcldir/pkgs/package.list.txt] try { foreach line [split [read $f] \n] { if {[string trim $line] eq ""} continue if {[string match #* $line]} continue lassign $line dir name lappend packageDirNameMap $dir $name } | > | 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 | # Get the list of packages to try, and what their human-readable names # are. Note that the package directory list should be version-less. try { set packageDirNameMap {} if {$build_tcl} { set f [open $tcltkdir/$tcldir/pkgs/package.list.txt] fconfigure $f -encoding utf-8 try { foreach line [split [read $f] \n] { if {[string trim $line] eq ""} continue if {[string match #* $line]} continue lassign $line dir name lappend packageDirNameMap $dir $name } |
︙ | ︙ | |||
797 798 799 800 801 802 803 | # # Invoke the scraper/converter engine. # make-man-pages $webdir \ [list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \ "The interpreters which implement $cmdesc."] \ [plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \ | | | | 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 | # # Invoke the scraper/converter engine. # make-man-pages $webdir \ [list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \ "The interpreters which implement $cmdesc."] \ [plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \ "The commands which the <b>tclsh</b> interpreter implements."] \ [plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \ "The additional commands which the <b>wish</b> interpreter implements."] \ {*}[plus-pkgs n {*}$packageBuildList] \ [plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \ "The C functions which a Tcl extended C program may use."] \ [plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \ "The additional C functions which a Tk extended C program may use."] \ {*}[plus-pkgs 3 {*}$packageBuildList] } on error {msg opts} { |
︙ | ︙ |
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 (c) 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 |
︙ | ︙ | |||
173 174 175 176 177 178 179 | buildTables $data puts "X = [llength $pMap] Y= [llength $pages] A= [llength $groups]" set size [expr {[llength $pMap]*2 + ([llength $pages]<<$shift)}] puts "shift = $shift, space = $size" set f [open [file join [lindex $argv 1] tclUniData.c] w] | | | | 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 | buildTables $data puts "X = [llength $pMap] Y= [llength $pages] A= [llength $groups]" set size [expr {[llength $pMap]*2 + ([llength $pages]<<$shift)}] puts "shift = $shift, space = $size" set f [open [file join [lindex $argv 1] tclUniData.c] w] fconfigure $f -translation lf -encoding utf-8 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 (c) 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.
︙ | ︙ | |||
336 337 338 339 340 341 342 | bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \ bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \ bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_set_i64.o \ bn_mp_read_radix.o bn_mp_rshd.o \ bn_mp_set_u64.o bn_mp_shrink.o \ bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \ bn_mp_signed_rsh.o \ | | > > | 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 | bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \ bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \ bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_set_i64.o \ bn_mp_read_radix.o bn_mp_rshd.o \ bn_mp_set_u64.o bn_mp_shrink.o \ bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \ bn_mp_signed_rsh.o \ bn_mp_to_ubin.o bn_mp_unpack.o \ bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o bn_mp_to_radix.o \ bn_mp_ubin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o STUB_LIB_OBJS = tclStubLib.o \ tclStubCall.o \ tclStubLibTbl.o \ tclTomMathStubLib.o \ tclOOStubLib.o \ ${COMPAT_OBJS} UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ tclUnixFile.o tclUnixPipe.o tclUnixSock.o \ tclUnixTime.o tclUnixInit.o tclUnixThrd.o \ |
︙ | ︙ | |||
484 485 486 487 488 489 490 491 492 493 494 495 496 497 | $(GENERIC_DIR)/tclOODefineCmds.c \ $(GENERIC_DIR)/tclOOInfo.c \ $(GENERIC_DIR)/tclOOMethod.c \ $(GENERIC_DIR)/tclOOStubInit.c STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c TOMMATH_SRCS = \ $(TOMMATH_DIR)/bn_cutoffs.c \ $(TOMMATH_DIR)/bn_deprecated.c \ $(TOMMATH_DIR)/bn_mp_2expt.c \ | > > | 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 | $(GENERIC_DIR)/tclOODefineCmds.c \ $(GENERIC_DIR)/tclOOInfo.c \ $(GENERIC_DIR)/tclOOMethod.c \ $(GENERIC_DIR)/tclOOStubInit.c STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ $(GENERIC_DIR)/tclStubCall.c \ $(GENERIC_DIR)/tclStubLibTbl.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c TOMMATH_SRCS = \ $(TOMMATH_DIR)/bn_cutoffs.c \ $(TOMMATH_DIR)/bn_deprecated.c \ $(TOMMATH_DIR)/bn_mp_2expt.c \ |
︙ | ︙ | |||
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 \ | | > | 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 | $(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 \ |
︙ | ︙ | |||
723 724 725 726 727 728 729 730 731 732 733 734 735 736 | TCL_VFS_ROOT = libtcl.vfs TCL_VFS_PATH = ${TCL_VFS_ROOT}/tcl_library HOST_CC = @CC_FOR_BUILD@ HOST_EXEEXT = @EXEEXT_FOR_BUILD@ HOST_OBJEXT = @OBJEXT_FOR_BUILD@ ZIPFS_BUILD = @ZIPFS_BUILD@ NATIVE_ZIP = @ZIP_PROG@ ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@ ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@ SHARED_BUILD = @SHARED_BUILD@ INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ INSTALL_MSGS = @INSTALL_MSGS@ | > | 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 | TCL_VFS_ROOT = libtcl.vfs TCL_VFS_PATH = ${TCL_VFS_ROOT}/tcl_library HOST_CC = @CC_FOR_BUILD@ HOST_EXEEXT = @EXEEXT_FOR_BUILD@ HOST_OBJEXT = @OBJEXT_FOR_BUILD@ ZIPFS_BUILD = @ZIPFS_BUILD@ MACHER = @MACHER_PROG@ NATIVE_ZIP = @ZIP_PROG@ ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@ ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@ SHARED_BUILD = @SHARED_BUILD@ INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ INSTALL_MSGS = @INSTALL_MSGS@ |
︙ | ︙ | |||
773 774 775 776 777 778 779 | @echo "creating ${TCL_VFS_PATH} (prepare compression)" @if \ ln -s $(TOP_DIR)/library/* ${TCL_VFS_PATH}/; \ then : ; else \ cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \ fi mv ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl | | > > > > | 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 | @echo "creating ${TCL_VFS_PATH} (prepare compression)" @if \ ln -s $(TOP_DIR)/library/* ${TCL_VFS_PATH}/; \ then : ; else \ cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \ fi mv ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl rm -rf ${TCL_VFS_PATH}/dde ${TCL_VFS_PATH}/registry @find ${TCL_VFS_ROOT} -type d -empty -delete @echo "creating ${TCL_ZIP_FILE} from ${TCL_VFS_PATH}" @(zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}' || \ echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?") 2>/dev/null`; \ echo 'cd ${TCL_VFS_ROOT} &&' $$zip '${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH}'; \ cd ${TCL_VFS_ROOT} && \ $$zip ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} >/dev/null) # The following target is configured by autoconf to generate either a shared # library or non-shared library for Tcl. ${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} ${TCL_ZIP_FILE} rm -f $@ @MAKE_LIB@ @if test "${ZIPFS_BUILD}" = "1" ; then \ if test "x$(MACHER)" = "x" ; then \ cat ${TCL_ZIP_FILE} >> ${LIB_FILE}; \ else $(MACHER) append ${LIB_FILE} ${TCL_ZIP_FILE} /tmp/macher_output; \ mv /tmp/macher_output ${LIB_FILE}; chmod u+x ${LIB_FILE}; \ fi; \ ${NATIVE_ZIP} -A ${LIB_FILE} \ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ fi ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} @if [ "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll" ] ; then \ ( cd ${TOP_DIR}/win; ${MAKE} winextensions ); \ |
︙ | ︙ | |||
810 811 812 813 814 815 816 | # The dependency on OBJS is not there because we just want the list of objects # here, not actually building them tclLibObjs: @echo ${OBJS} # This targets actually build the objects needed for the lib in the above case objs: ${OBJS} | | > > > > > > > > > | 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 | # The dependency on OBJS is not there because we just want the list of objects # here, not actually building them tclLibObjs: @echo ${OBJS} # This targets actually build the objects needed for the lib in the above case objs: ${OBJS} ${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${TCL_ZIP_FILE} ${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} \ @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCL_EXE} @if test "${ZIPFS_BUILD}" = "2" ; then \ if test "x$(MACHER)" = "x" ; then \ cat ${TCL_ZIP_FILE} >> ${TCL_EXE}; \ else $(MACHER) append ${TCL_EXE} ${TCL_ZIP_FILE} /tmp/macher_output; \ mv /tmp/macher_output ${TCL_EXE}; chmod u+x ${TCL_EXE}; \ fi; \ ${NATIVE_ZIP} -A ${TCL_EXE} \ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ fi # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above ${NATIVE_TCLSH}: Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in $(SHELL) config.status #tclConfig.h: $(UNIX_DIR)/tclConfig.h.in |
︙ | ︙ | |||
927 928 929 930 931 932 933 934 935 936 937 938 939 940 | shell: ${TCL_EXE} $(SHELL_ENV) ./${TCL_EXE} $(SCRIPT) # This target can be used to run tclsh inside either gdb or insight gdb: ${TCL_EXE} $(SHELL_ENV) $(GDB) ./${TCL_EXE} valgrind: ${TCL_EXE} ${TCLTEST_EXE} $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \ $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \ $(TESTFLAGS) valgrindshell: ${TCL_EXE} $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT) | > > > | 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 | shell: ${TCL_EXE} $(SHELL_ENV) ./${TCL_EXE} $(SCRIPT) # This target can be used to run tclsh inside either gdb or insight gdb: ${TCL_EXE} $(SHELL_ENV) $(GDB) ./${TCL_EXE} lldb: ${TCL_EXE} $(SHELL_ENV) $(LLDB) ./${TCL_EXE} valgrind: ${TCL_EXE} ${TCLTEST_EXE} $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \ $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \ $(TESTFLAGS) valgrindshell: ${TCL_EXE} $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT) |
︙ | ︙ | |||
987 988 989 990 991 992 993 | @INSTALL_STUB_LIB@ ; \ fi @EXTRA_INSTALL_BINARIES@ @echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/" @$(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/pkgconfig" @$(INSTALL_DATA) tcl.pc "$(LIB_INSTALL_DIR)/pkgconfig/tcl.pc" | < < < < < < < < < < < < < < < | 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 | @INSTALL_STUB_LIB@ ; \ fi @EXTRA_INSTALL_BINARIES@ @echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/" @$(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/pkgconfig" @$(INSTALL_DATA) tcl.pc "$(LIB_INSTALL_DIR)/pkgconfig/tcl.pc" 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; \ |
︙ | ︙ | |||
1046 1047 1048 1049 1050 1051 1052 | @echo "Installing package opt 0.4.7" @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)/9.0/msgcat-1.7.1.tm" | | | | | | 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 | @echo "Installing package opt 0.4.7" @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)/9.0/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)/9.0/tcltest-2.5.4.tm" @echo "Installing package platform 1.0.17 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.17.tm" @echo "Installing package platform::shell 1.1.4 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \ "$(MODULE_INSTALL_DIR)/9.0/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 |
︙ | ︙ | |||
1466 1467 1468 1469 1470 1471 1472 | -DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \ -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ -DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \ -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \ -DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \ -DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ | < | 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 | -DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \ -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ -DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \ -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \ -DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \ -DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ $(GENERIC_DIR)/tclPkgConfig.c tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPosixStr.c tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c |
︙ | ︙ | |||
1520 1521 1522 1523 1524 1525 1526 | 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) \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ | < < | 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 | 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) \ -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) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS) |
︙ | ︙ | |||
1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 | bn_mp_to_radix.o: $(TOMMATH_DIR)/bn_mp_to_radix.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_radix.c bn_mp_ubin_size.o: $(TOMMATH_DIR)/bn_mp_ubin_size.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_ubin_size.c bn_mp_xor.o: $(TOMMATH_DIR)/bn_mp_xor.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_xor.c bn_mp_zero.o: $(TOMMATH_DIR)/bn_mp_zero.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_zero.c bn_s_mp_add.o: $(TOMMATH_DIR)/bn_s_mp_add.c $(MATHHDRS) | > > > | 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 | bn_mp_to_radix.o: $(TOMMATH_DIR)/bn_mp_to_radix.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_radix.c bn_mp_ubin_size.o: $(TOMMATH_DIR)/bn_mp_ubin_size.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_ubin_size.c bn_mp_unpack.o: $(TOMMATH_DIR)/bn_mp_unpack.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_unpack.c bn_mp_xor.o: $(TOMMATH_DIR)/bn_mp_xor.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_xor.c bn_mp_zero.o: $(TOMMATH_DIR)/bn_mp_zero.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_zero.c bn_s_mp_add.o: $(TOMMATH_DIR)/bn_s_mp_add.c $(MATHHDRS) |
︙ | ︙ | |||
1766 1767 1768 1769 1770 1771 1772 | 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 | | | | | 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 | 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 |
︙ | ︙ | |||
1903 1904 1905 1906 1907 1908 1909 | #-------------------------------------------------------------------------- # Stub library binaries, these must be compiled for use in a shared library # even though they will be placed in a static archive #-------------------------------------------------------------------------- tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c | > > > > > > > > > > | | | | 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 | #-------------------------------------------------------------------------- # Stub library binaries, these must be compiled for use in a shared library # even though they will be placed in a static archive #-------------------------------------------------------------------------- tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclStubLib.c tclStubCall.o: $(GENERIC_DIR)/tclStubCall.c $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ -DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \ $(GENERIC_DIR)/tclStubCall.c tclStubLibTbl.o: $(GENERIC_DIR)/tclStubLibTbl.c $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLibTbl.c tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclTomMathStubLib.c tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c $(CC) -c $(STUB_CC_SWITCHES) @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclOOStubLib.c .c.o: $(CC) -c $(CC_SWITCHES) $< #-------------------------------------------------------------------------- # Minizip implementation #-------------------------------------------------------------------------- |
︙ | ︙ | |||
2216 2217 2218 2219 2220 2221 2222 | DISTROOT = /tmp/dist DISTNAME = tcl${VERSION}${PATCH_LEVEL} ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip DISTDIR = $(DISTROOT)/$(DISTNAME) DIST_INSTALL_DATA = CPPROG='cp -p' $(INSTALL) -m 644 DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755 | | | 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 | DISTROOT = /tmp/dist DISTNAME = tcl${VERSION}${PATCH_LEVEL} ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip DISTDIR = $(DISTROOT)/$(DISTNAME) DIST_INSTALL_DATA = CPPROG='cp -p' $(INSTALL) -m 644 DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755 BUILTIN_PACKAGE_LIST = cookiejar http opt msgcat registry dde tcltest platform $(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 |
︙ | ︙ | |||
2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 | | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \ | ( cd $(DISTDIR)/compat/zlib ; tar xfp - ) $(INSTALL_DATA_DIR) $(DISTDIR)/tests $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/tests $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(DISTDIR)/tests $(INSTALL_DATA_DIR) $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/configure.ac \ $(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 \ $(DISTDIR)/win $(DIST_INSTALL_SCRIPT) $(TOP_DIR)/win/configure $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.bat $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.vc $(DISTDIR)/win | > > > > > > > > > > > > > < | 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 | | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \ | ( cd $(DISTDIR)/compat/zlib ; tar xfp - ) $(INSTALL_DATA_DIR) $(DISTDIR)/tests $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/tests $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(DISTDIR)/tests @mkdir $(DISTDIR)/tests/auto0 for i in auto1 auto2 ; \ do \ $(INSTALL_DATA_DIR) $(DISTDIR)/tests/auto0/$$i ;\ $(DIST_INSTALL_DATA) $(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 \ $(INSTALL_DATA_DIR) $(DISTDIR)/tests/auto0/$$i ;\ $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/auto0/$$i/*.tm \ $(DISTDIR)/tests/auto0/$$i; \ done; $(INSTALL_DATA_DIR) $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/configure.ac \ $(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 \ $(DISTDIR)/win $(DIST_INSTALL_SCRIPT) $(TOP_DIR)/win/configure $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.bat $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.vc $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/README $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/win $(INSTALL_DATA_DIR) $(DISTDIR)/macosx $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \ $(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \ |
︙ | ︙ | |||
2321 2322 2323 2324 2325 2326 2327 | $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcodeproj $(INSTALL_DATA_DIR) $(DISTDIR)/unix/dltest $(DIST_INSTALL_DATA) $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest $(INSTALL_DATA_DIR) $(DISTDIR)/tools | | < | < | | > > > | 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 | $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcodeproj $(INSTALL_DATA_DIR) $(DISTDIR)/unix/dltest $(DIST_INSTALL_DATA) $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest $(INSTALL_DATA_DIR) $(DISTDIR)/tools $(DIST_INSTALL_DATA) $(TOOL_DIR)/README $(TOOL_DIR)/*.c $(TOOL_DIR)/*.svg \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/*.bmp \ $(TOOL_DIR)/valgrind_suppress $(DISTDIR)/tools chmod 755 $(DISTDIR)/tools/checkLibraryDoc.tcl \ $(DISTDIR)/tools/findBadExternals.tcl \ $(DISTDIR)/tools/loadICU.tcl \ $(DISTDIR)/tools/makeTestCases.tcl $(DISTDIR)/tools/tclZIC.tcl \ $(DISTDIR)/tools/tcltk-man2html.tcl $(INSTALL_DATA_DIR) $(DISTDIR)/libtommath $(DIST_INSTALL_DATA) $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath $(INSTALL_DATA_DIR) $(DISTDIR)/pkgs $(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs $(DIST_INSTALL_DATA) $(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 $(DIST_INSTALL_DATA) $(TOP_DIR)/.travis.yml $(DISTDIR) $(INSTALL_DATA_DIR) $(DISTDIR)/.github/workflows $(DIST_INSTALL_DATA) $(TOP_DIR)/.github/workflows/*.yml $(DISTDIR)/.github/workflows alldist: dist rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) ( cd $(DISTROOT); \ tar cf $(DISTNAME)-src.tar $(DISTNAME); \ gzip -9 $(DISTNAME)-src.tar; \ zip -qr8 $(ZIPNAME) $(DISTNAME) ) |
︙ | ︙ | |||
2394 2395 2396 2397 2398 2399 2400 | .PHONY: clean distclean depend genstubs checkstubs checkexports checkuchar .PHONY: shell gdb valgrind valgrindshell dist alldist rpm .PHONY: tclLibObjs tcltest-real test-tcl gdb-test ro-test trace-test xttest .PHONY: topDirName gendate gentommath_h trace-shell checkdoc .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages | | | 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 | .PHONY: clean distclean depend genstubs checkstubs checkexports checkuchar .PHONY: shell gdb valgrind valgrindshell dist alldist rpm .PHONY: tclLibObjs tcltest-real test-tcl gdb-test ro-test trace-test xttest .PHONY: topDirName gendate gentommath_h trace-shell checkdoc .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages .PHONY: tclzipfile #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. |
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 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 | #! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.70 for tcl 9.0. # # # Copyright (C) 1992-1996, 1998-2017, 2020 Free Software Foundation, Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else $as_nop case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Use a proper internal environment variable to ensure we don't fall # into an infinite loop, continuously re-executing ourselves. if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then _as_can_reexec=no; export _as_can_reexec; # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also |
︙ | ︙ | |||
148 149 150 151 152 153 154 | *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. | | | | > > | | > | > > | > | | > | > | > > > | | > | > > > > > > | | > | < > | > | | > | | | | | | | 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 | *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="as_nop=: if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST else \$as_nop case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi " as_required="as_fn_return () { (exit \$1); } as_fn_success () { as_fn_return 0; } as_fn_failure () { as_fn_return 1; } as_fn_ret_success () { return 0; } as_fn_ret_failure () { return 1; } exitcode=0 as_fn_success || { exitcode=1; echo as_fn_success failed.; } as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : else \$as_nop exitcode=1; echo positional parameters were not saved. fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah)) test x\"\$blah\" = xblah || exit 1 test -x / || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 test \$(( 1 + 1 )) = 2 || exit 1" if (eval "$as_required") 2>/dev/null then : as_have_required=yes else $as_nop as_have_required=no fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : else $as_nop as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac as_found=: case $as_dir in #( /*) for as_base in sh bash ksh sh5; do # Try only shells that exist, to save several forks. as_shell=$as_dir$as_base if { test -f "$as_shell" || test -f "$as_shell.exe"; } && as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$as_shell as_have_required=yes if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null then : break 2 fi fi done;; esac as_found=false done IFS=$as_save_IFS if $as_found then : else $as_nop if { test -f "$SHELL" || test -f "$SHELL.exe"; } && as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$SHELL as_have_required=yes fi fi if test "x$CONFIG_SHELL" != x then : export CONFIG_SHELL # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi if test x$as_have_required = xno then : printf "%s\n" "$0: This script requires a shell more modern than all" printf "%s\n" "$0: the shells that I found on your system." if test ${ZSH_VERSION+y} ; then printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should" printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later." else printf "%s\n" "$0: Please tell [email protected] about your system, $0: including any error possibly output before this $0: message. Then install a modern shell, or manually run $0: the script under such a shell if you do have one." fi exit 1 fi fi |
︙ | ︙ | |||
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 | # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( | > > > > > > > > > | | | 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 | # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_nop # --------- # Do nothing but, unlike ":", preserve the value of $?. as_fn_nop () { return $? } as_nop=as_fn_nop # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q |
︙ | ︙ | |||
366 367 368 369 370 371 372 | } # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. | | > | | > | > > > > > > > > | | | 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 | } # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else $as_nop as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else $as_nop as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith # as_fn_nop # --------- # Do nothing but, unlike ":", preserve the value of $?. as_fn_nop () { return $? } as_nop=as_fn_nop # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else |
︙ | ︙ | |||
435 436 437 438 439 440 441 | as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || | | | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 | as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q |
︙ | ︙ | |||
479 480 481 482 483 484 485 | N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || | | > > > > > > > > > > > | 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 | N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } # If we had to re-execute with $CONFIG_SHELL, we're ensured to have # already done that, so ensure we don't try to do so again and fall # in an infinite loop. This has already happened in practice. _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null |
︙ | ︙ | |||
580 581 582 583 584 585 586 | PACKAGE_VERSION='9.0' PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' # Factoring default headers for most tests. ac_includes_default="\ | | | | | < < < < < < < < < < < < < < > > > > > > > > > > | 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 | PACKAGE_VERSION='9.0' PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' # Factoring default headers for most tests. ac_includes_default="\ #include <stddef.h> #ifdef HAVE_STDIO_H # include <stdio.h> #endif #ifdef HAVE_STDLIB_H # include <stdlib.h> #endif #ifdef HAVE_STRING_H # include <string.h> #endif #ifdef HAVE_INTTYPES_H # include <inttypes.h> #endif #ifdef HAVE_STDINT_H # include <stdint.h> #endif #ifdef HAVE_STRINGS_H # include <strings.h> #endif #ifdef HAVE_SYS_TYPES_H # include <sys/types.h> #endif #ifdef HAVE_SYS_STAT_H # include <sys/stat.h> #endif #ifdef HAVE_UNISTD_H # include <unistd.h> #endif" ac_header_c_list= ac_subst_vars='DLTEST_SUFFIX DLTEST_LD EXTRA_TCLSH_LIBS EXTRA_BUILD_HTML EXTRA_INSTALL_BINARIES EXTRA_INSTALL EXTRA_APP_CC_SWITCHES |
︙ | ︙ | |||
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 | TCL_INCLUDE_SPEC TCL_STUB_LIB_PATH TCL_STUB_LIB_SPEC TCL_STUB_LIB_FLAG TCL_STUB_LIB_FILE TCL_LIB_SPEC TCL_LIB_FLAG TCL_LIB_FILE PKG_CFG_ARGS TCL_YEAR TCL_PATCH_LEVEL TCL_MINOR_VERSION TCL_MAJOR_VERSION TCL_VERSION INSTALL_MSGS INSTALL_LIBRARIES TCL_ZIP_FILE ZIPFS_BUILD ZIP_INSTALL_OBJS ZIP_PROG_VFSSEARCH ZIP_PROG_OPTIONS ZIP_PROG EXEEXT_FOR_BUILD CC_FOR_BUILD DTRACE LDFLAGS_DEFAULT CFLAGS_DEFAULT INSTALL_STUB_LIB DLL_INSTALL_DIR | > > | 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 | TCL_INCLUDE_SPEC TCL_STUB_LIB_PATH TCL_STUB_LIB_SPEC TCL_STUB_LIB_FLAG TCL_STUB_LIB_FILE TCL_LIB_SPEC TCL_LIB_FLAG TCL_PREV_LIB_FILE TCL_LIB_FILE PKG_CFG_ARGS TCL_YEAR TCL_PATCH_LEVEL TCL_MINOR_VERSION TCL_MAJOR_VERSION TCL_VERSION INSTALL_MSGS INSTALL_LIBRARIES TCL_ZIP_FILE ZIPFS_BUILD ZIP_INSTALL_OBJS ZIP_PROG_VFSSEARCH ZIP_PROG_OPTIONS ZIP_PROG MACHER_PROG EXEEXT_FOR_BUILD CC_FOR_BUILD DTRACE LDFLAGS_DEFAULT CFLAGS_DEFAULT INSTALL_STUB_LIB DLL_INSTALL_DIR |
︙ | ︙ | |||
689 690 691 692 693 694 695 696 697 698 699 700 701 702 | TCL_SHLIB_LD_EXTRAS SHLIB_LD STLIB_LD LD_SEARCH_FLAGS CC_SEARCH_FLAGS LDFLAGS_OPTIMIZE LDFLAGS_DEBUG CFLAGS_WARNING CFLAGS_OPTIMIZE CFLAGS_DEBUG LDAIX_SRC PLAT_SRCS PLAT_OBJS DL_OBJS | > | 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 | TCL_SHLIB_LD_EXTRAS SHLIB_LD STLIB_LD LD_SEARCH_FLAGS CC_SEARCH_FLAGS LDFLAGS_OPTIMIZE LDFLAGS_DEBUG CFLAGS_NOLTO CFLAGS_WARNING CFLAGS_OPTIMIZE CFLAGS_DEBUG LDAIX_SRC PLAT_SRCS PLAT_OBJS DL_OBJS |
︙ | ︙ | |||
739 740 741 742 743 744 745 746 747 748 749 750 751 752 | pdfdir dvidir htmldir infodir docdir oldincludedir includedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir | > | 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 | pdfdir dvidir htmldir infodir docdir oldincludedir includedir runstatedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir |
︙ | ︙ | |||
778 779 780 781 782 783 784 | enable_corefoundation enable_load enable_symbols enable_langinfo enable_dll_unloading with_tzdata enable_dtrace | | | | 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 | enable_corefoundation enable_load enable_symbols enable_langinfo enable_dll_unloading with_tzdata enable_dtrace enable_framework enable_zipfs ' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS |
︙ | ︙ | |||
828 829 830 831 832 833 834 835 836 837 838 839 840 841 | sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' | > | 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 | sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' |
︙ | ︙ | |||
857 858 859 860 861 862 863 | case $ac_option in *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *=) ac_optarg= ;; *) ac_optarg=yes ;; esac | < < | 888 889 890 891 892 893 894 895 896 897 898 899 900 901 | case $ac_option in *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *=) ac_optarg= ;; *) ac_optarg=yes ;; esac case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) |
︙ | ︙ | |||
899 900 901 902 903 904 905 | | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && | | | | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 | | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac |
︙ | ︙ | |||
925 926 927 928 929 930 931 | -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && | | | | 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 | -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac |
︙ | ︙ | |||
1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 | ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; | > > > > > > > > > | 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 | ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -runstatedir | --runstatedir | --runstatedi | --runstated \ | --runstate | --runstat | --runsta | --runst | --runs \ | --run | --ru | --r) ac_prev=runstatedir ;; -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ | --run=* | --ru=* | --r=*) runstatedir=$ac_optarg ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; |
︙ | ︙ | |||
1129 1130 1131 1132 1133 1134 1135 | -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && | | | | | | 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 | -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac |
︙ | ︙ | |||
1191 1192 1193 1194 1195 1196 1197 | as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. | | | | | | 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 | as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2 : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` eval $ac_var=\$ac_val;; |
︙ | ︙ | |||
1273 1274 1275 1276 1277 1278 1279 | ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || | | | 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 | ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q |
︙ | ︙ | |||
1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 | Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] | > | 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 | Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] |
︙ | ︙ | |||
1418 1419 1420 1421 1422 1423 1424 | --enable-load allow dynamic loading and "load" command (default: on) --enable-symbols build with debugging symbols (default: off) --enable-langinfo use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on) --enable-dll-unloading enable the 'unload' command (default: on) --enable-dtrace build with DTrace support (default: off) | < > | < | 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 | --enable-load allow dynamic loading and "load" command (default: on) --enable-symbols build with debugging symbols (default: off) --enable-langinfo use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on) --enable-dll-unloading enable the 'unload' command (default: on) --enable-dtrace build with DTrace support (default: off) --enable-framework package shared libraries in MacOSX frameworks (default: off) --enable-zipfs build with Zipfs support (default: on) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values (default: utf-8) --with-system-libtommath use external libtommath (default: true if available, false otherwise) --with-tzdata install timezone data (default: autodetect) Some influential environment variables: CC C compiler command |
︙ | ︙ | |||
1461 1462 1463 1464 1465 1466 1467 | { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) | | | | 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 | { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix |
︙ | ︙ | |||
1491 1492 1493 1494 1495 1496 1497 | ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } | | > | | | | | | | > | | | | | > | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | > | | | | < < < | < < < < | | > | | | | > | | | > | | | > > | | > | | > | | | | > | | | | | > | | > | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > | | | | | > | | | > | | | | | > > > > > > > > > > > > > > > > > > > > | | | 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 | ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for configure.gnu first; this name is used for a wrapper for # Metaconfig's "Configure" on case-insensitive file systems. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 9.0 generated by GNU Autoconf 2.70 Copyright (C) 2020 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## ## Autoconf initialization. ## ## ------------------------ ## # ac_fn_c_try_compile LINENO # -------------------------- # Try to compile conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_link () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes || test -x conftest$ac_exeext } then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link # ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES # ------------------------------------------------------- # Tests whether HEADER exists and can be compiled using the include files in # INCLUDES, setting the cache variable VAR accordingly. ac_fn_c_check_header_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 #include <$2> _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$3=yes" else $as_nop eval "$3=no" fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_compile # ac_fn_c_try_cpp LINENO # ---------------------- # Try to preprocess conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_cpp () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack if { { ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } > conftest.i && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err } then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_cpp # ac_fn_c_check_func LINENO FUNC VAR # ---------------------------------- # Tests whether FUNC exists, setting the cache variable VAR accordingly ac_fn_c_check_func () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Define $2 to an innocuous variant, in case <limits.h> declares $2. For example, HP-UX 11i <limits.h> declares gettimeofday. */ #define $2 innocuous_$2 /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $2 (); below. */ #include <limits.h> #undef $2 /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $2 (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$2 || defined __stub___$2 choke me #endif int main (void) { return $2 (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : eval "$3=yes" else $as_nop eval "$3=no" fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_func # ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES # --------------------------------------------- # Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR # accordingly. ac_fn_c_check_decl () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack # Initialize each $ac_[]_AC_LANG_ABBREV[]_decl_warn_flag once. as_decl_name=`echo $2|sed 's/ *(.*//'` as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` { 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 ac_save_werror_flag=$ac_c_werror_flag ac_c_werror_flag="$ac_c_decl_warn_flag$ac_c_werror_flag" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 int main (void) { #ifndef $as_decl_name #ifdef __cplusplus (void) $as_decl_use; #else (void) $as_decl_name; #endif #endif ; return 0; } _ACEOF 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 ac_c_werror_flag=$ac_save_werror_flag fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_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 () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 else $as_nop eval "$3=no" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 int main (void) { if (sizeof ($2)) return 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 int main (void) { if (sizeof (($2))) return 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : else $as_nop eval "$3=yes" 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 fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_type # ac_fn_c_try_run LINENO # ---------------------- # Try to run conftest.$ac_ext, and return whether this succeeded. Assumes that # executables *can* be run. ac_fn_c_try_run () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; } then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: program exited with status $ac_status" >&5 printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=$ac_status fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_run # ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES # ---------------------------------------------------- # Tries to find if the field MEMBER exists in type AGGR, after including # INCLUDES, setting cache variable VAR accordingly. ac_fn_c_check_member () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 printf %s "checking for $2.$3... " >&6; } if eval test \${$4+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $5 int main (void) { static $2 ac_aggr; if (ac_aggr.$3) return 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$4=yes" else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $5 int main (void) { static $2 ac_aggr; if (sizeof ac_aggr.$3) return 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$4=yes" else $as_nop eval "$4=no" 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 fi eval ac_res=\$$4 { 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_member ac_configure_args_raw= for ac_arg do case $ac_arg in *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac as_fn_append ac_configure_args_raw " '$ac_arg'" done case $ac_configure_args_raw in *$as_nl*) ac_safe_unquote= ;; *) ac_unsafe_z='|&;<>()$`\\"*?[ '' ' # This string ends in space, tab. ac_unsafe_a="$ac_unsafe_z#~" ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g" ac_configure_args_raw=` printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;; esac cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 9.0, which was generated by GNU Autoconf 2.70. Invocation command line was $ $0$ac_configure_args_raw _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## |
︙ | ︙ | |||
2066 2067 2068 2069 2070 2071 2072 | _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS | > | > > > | | 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 | _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac printf "%s\n" "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF |
︙ | ︙ | |||
2102 2103 2104 2105 2106 2107 2108 | do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) | | | 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 | do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. |
︙ | ︙ | |||
2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 | # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo | > > | | | | 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 | # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Sanitize IFS. IFS=" "" $as_nl" # Save into config.log some information that might help in debugging. { echo printf "%s\n" "## ---------------- ## ## Cache variables. ## ## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac |
︙ | ︙ | |||
2177 2178 2179 2180 2181 2182 2183 | sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo | | | | | | | | | | | < | < < | < < | < < | < < | < < | < < < < | < < < < | < | < > | | > > > > > | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | | | | | > | | 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 | sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo printf "%s\n" "## ----------------- ## ## Output variables. ## ## ----------------- ##" echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then printf "%s\n" "## ------------------- ## ## File substitutions. ## ## ------------------- ##" echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then printf "%s\n" "## ----------- ## ## confdefs.h. ## ## ----------- ##" echo cat confdefs.h echo fi test "$ac_signal" != 0 && printf "%s\n" "$as_me: caught signal $ac_signal" printf "%s\n" "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h printf "%s\n" "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h # Let the site file select an alternate cache file if it wants to. # Prefer an explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then ac_site_files="$CONFIG_SITE" elif test "x$prefix" != xNONE; then ac_site_files="$prefix/share/config.site $prefix/etc/config.site" else ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi for ac_site_file in $ac_site_files do case $ac_site_file in #( */*) : ;; #( *) : ac_site_file=./$ac_site_file ;; esac if test -f "$ac_site_file" && test -r "$ac_site_file"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file See \`config.log' for more details" "$LINENO" 5; } fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special files # actually), so we avoid doing that. DJGPP emulates it as a regular file. if test /dev/null != "$cache_file" && test -f "$cache_file"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 printf "%s\n" "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 printf "%s\n" "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Test code for whether the C compiler supports C89 (global declarations) ac_c_conftest_c89_globals=' /* Does the compiler advertise C89 conformance? Do not test the value of __STDC__, because some compilers set it to 0 while being otherwise adequately conformant. */ #if !defined __STDC__ # error "Compiler does not advertise C89 conformance" #endif #include <stddef.h> #include <stdarg.h> struct stat; /* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not \xHH hex character constants. These do not provoke an error unfortunately, instead are silently treated as an "x". The following induces an error, until -std is added to get proper ANSI mode. Curiously \x00 != x always comes out true, for an array size at least. It is necessary to write \x00 == 0 to get something that is true only with -std. */ int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) '\''x'\'' int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int), int, int);' # Test code for whether the C compiler supports C89 (body of main). ac_c_conftest_c89_main=' ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); ' # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals=' // Does the compiler advertise C99 conformance? #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif #include <stdbool.h> extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t); // Check varargs macros. These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare // FILE and stderr. #define debug(...) dprintf (2, __VA_ARGS__) #define showlist(...) puts (#__VA_ARGS__) #define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) static void test_varargs_macros (void) { int x = 1234; int y = 5678; debug ("Flag"); debug ("X = %d\n", x); showlist (The first, second, and third items.); report (x>y, "x is %d but y is %d", x, y); } // Check long long types. #define BIG64 18446744073709551615ull #define BIG32 4294967295ul #define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) #if !BIG_OK #error "your preprocessor is broken" #endif #if BIG_OK #else #error "your preprocessor is broken" #endif static long long int bignum = -9223372036854775807LL; static unsigned long long int ubignum = BIG64; struct incomplete_array { int datasize; double data[]; }; struct named_init { int number; const wchar_t *name; double average; }; typedef const char *ccp; static inline int test_restrict (ccp restrict text) { // See if C++-style comments work. // Iterate through items via the restricted pointer. // Also check for declarations in for loops. for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) continue; return 0; } // Check varargs and va_copy. static bool test_varargs (const char *format, ...) { va_list args; va_start (args, format); va_list args_copy; va_copy (args_copy, args); const char *str = ""; int number = 0; float fnumber = 0; while (*format) { switch (*format++) { case '\''s'\'': // string str = va_arg (args_copy, const char *); break; case '\''d'\'': // int number = va_arg (args_copy, int); break; case '\''f'\'': // float fnumber = va_arg (args_copy, double); break; default: break; } } va_end (args_copy); va_end (args); return *str && number && fnumber; } ' # Test code for whether the C compiler supports C99 (body of main). ac_c_conftest_c99_main=' // Check bool. _Bool success = false; success |= (argc != 0); // Check restrict. if (test_restrict ("String literal") == 0) success = true; char *restrict newvar = "Another string"; // Check varargs. success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234); test_varargs_macros (); // Check flexible array members. struct incomplete_array *ia = malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); ia->datasize = 10; for (int i = 0; i < ia->datasize; ++i) ia->data[i] = i * 1.234; // Check named initializers. struct named_init ni = { .number = 34, .name = L"Test wide string", .average = 543.34343, }; ni.number = 58; int dynamic_array[ni.number]; dynamic_array[0] = argv[0][0]; dynamic_array[ni.number - 1] = 543; // work around unused variable warnings ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\'' || dynamic_array[ni.number - 1] != 543); ' # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals=' // Does the compiler advertise C11 conformance? #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif // Check _Alignas. char _Alignas (double) aligned_as_double; char _Alignas (0) no_special_alignment; extern char aligned_as_int; char _Alignas (0) _Alignas (int) aligned_as_int; // Check _Alignof. enum { int_alignment = _Alignof (int), int_array_alignment = _Alignof (int[100]), char_alignment = _Alignof (char) }; _Static_assert (0 < -_Alignof (int), "_Alignof is signed"); // Check _Noreturn. int _Noreturn does_not_return (void) { for (;;) continue; } // Check _Static_assert. struct test_static_assert { int x; _Static_assert (sizeof (int) <= sizeof (long int), "_Static_assert does not work in struct"); long int y; }; // Check UTF-8 literals. #define u8 syntax error! char const utf8_literal[] = u8"happens to be ASCII" "another string"; // Check duplicate typedefs. typedef long *long_ptr; typedef long int *long_ptr; typedef long_ptr long_ptr; // Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1. struct anonymous { union { struct { int i; int j; }; struct { int k; long int l; } w; }; int m; } v1; ' # Test code for whether the C compiler supports C11 (body of main). ac_c_conftest_c11_main=' _Static_assert ((offsetof (struct anonymous, i) == offsetof (struct anonymous, w.k)), "Anonymous union alignment botch"); v1.i = 2; v1.w.k = 5; ok |= v1.i != 5; ' # Test code for whether the C compiler supports C11 (complete). ac_c_conftest_c11_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} ${ac_c_conftest_c11_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} ${ac_c_conftest_c11_main} return ok; } " # Test code for whether the C compiler supports C99 (complete). ac_c_conftest_c99_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} return ok; } " # Test code for whether the C compiler supports C89 (complete). ac_c_conftest_c89_program="${ac_c_conftest_c89_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} return ok; } " as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H" as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H" as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H" as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H" as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H" as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H" as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H" as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H" as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H" as_fn_append ac_header_c_list " sys/time.h sys_time_h HAVE_SYS_TIME_H" # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then # differences in whitespace do not lead to failure. ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 printf "%s\n" "$as_me: former value: \`$ac_old_val'" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## ## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' |
︙ | ︙ | |||
2432 2433 2434 2435 2436 2437 2438 | TCL_SRC_DIR="`cd "$srcdir"/..; pwd`" #------------------------------------------------------------------------ # Compress and/or soft link the manpages? #------------------------------------------------------------------------ | | | | > | | | | | | > | | | | | | | | | | > | | | > > > > > > > > > | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | > | | | > | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | > | | | | | | > | | | | | | | | | > | | | | > | | | | > > | | | | > | | | | > | | | > | | | > | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < | > | > | | | | | | | | | > | | | > > > > > > > > > | | | > | | | | | > | | | | 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 | TCL_SRC_DIR="`cd "$srcdir"/..; pwd`" #------------------------------------------------------------------------ # Compress and/or soft link the manpages? #------------------------------------------------------------------------ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use symlinks for manpages" >&5 printf %s "checking whether to use symlinks for manpages... " >&6; } # Check whether --enable-man-symlinks was given. if test ${enable_man_symlinks+y} then : enableval=$enable_man_symlinks; test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks" else $as_nop enableval="no" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 printf "%s\n" "$enableval" >&6; } { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to compress the manpages" >&5 printf %s "checking whether to compress the manpages... " >&6; } # Check whether --enable-man-compression was given. if test ${enable_man_compression+y} then : enableval=$enable_man_compression; case $enableval in yes) as_fn_error $? "missing argument to --enable-man-compression" "$LINENO" 5;; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac else $as_nop enableval="no" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 printf "%s\n" "$enableval" >&6; } if test "$enableval" != "no"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for compressed file suffix" >&5 printf %s "checking for compressed file suffix... " >&6; } touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $Z" >&5 printf "%s\n" "$Z" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to add a package name suffix for the manpages" >&5 printf %s "checking whether to add a package name suffix for the manpages... " >&6; } # Check whether --enable-man-suffix was given. if test ${enable_man_suffix+y} then : enableval=$enable_man_suffix; case $enableval in yes) enableval="tcl" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac else $as_nop enableval="no" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 printf "%s\n" "$enableval" >&6; } #------------------------------------------------------------------------ # Standard compiler checks #------------------------------------------------------------------------ # If the user did not set CFLAGS, set it now to keep # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. set dummy ${ac_tool_prefix}clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "clang", so it can be a program name with args. set dummy clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi fi test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 set X $ac_compile ac_compiler=$2 for ac_option in --version -v -V -qversion -version; do { { ac_try="$ac_compiler $ac_option >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compiler $ac_option >&5") 2>conftest.err ac_status=$? if test -s conftest.err; then sed '10a\ ... rest of stderr output deleted ... 10q' conftest.err >conftest.er1 cat conftest.er1 >&5 fi rm -f conftest.er1 conftest.err printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } done cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 printf %s "checking whether the C compiler works... " >&6; } ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # The possible output files: ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { { ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link_default") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else $as_nop ac_file='' fi if test -z "$ac_file" then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables See \`config.log' for more details" "$LINENO" 5; } else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; } { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 printf "%s\n" "$ac_file" >&6; } ac_exeext=$ac_cv_exeext rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 printf %s "checking for suffix of executables... " >&6; } if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else $as_nop { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 printf "%s\n" "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <stdio.h> int main (void) { FILE *f = fopen ("conftest.out", "w"); return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF ac_clean_files="$ac_clean_files conftest.out" # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 printf %s "checking whether we are cross compiling... " >&6; } if test "$cross_compiling" != yes; then { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } if { ac_try='./conftest$ac_cv_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details" "$LINENO" 5; } fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 printf %s "checking whether the compiler supports GNU C... " >&6; } if test ${ac_cv_c_compiler_gnu+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_compiler_gnu=yes else $as_nop ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } ac_compiler_gnu=$ac_cv_c_compiler_gnu if test $ac_compiler_gnu = yes; then GCC=yes else GCC= fi ac_test_CFLAGS=${CFLAGS+y} ac_save_CFLAGS=$CFLAGS { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 printf %s "checking whether $CC accepts -g... " >&6; } if test ${ac_cv_prog_cc_g+y} then : printf %s "(cached) " >&6 else $as_nop ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes else $as_nop CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : else $as_nop ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext 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 ac_c_werror_flag=$ac_save_c_werror_flag fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; } if test $ac_test_CFLAGS; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { 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 cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c11_program _ACEOF for ac_arg in '' -std=gnu11 do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c11=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL ac_prog_cc_stdc_options= case "x$ac_cv_prog_cc_c11" in #( x) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } ;; #( xno) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } ;; #( *) : ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c11" CC="$CC$ac_prog_cc_stdc_options" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } ;; esac if test "x$ac_cv_prog_cc_c11" != xno then : ac_prog_cc_stdc=c11 ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 else $as_nop { 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_c89_program _ACEOF for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99 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 # AC_CACHE_VAL ac_prog_cc_stdc_options= case "x$ac_cv_prog_cc_c99" in #( x) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } ;; #( xno) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } ;; #( *) : ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c99" CC="$CC$ac_prog_cc_stdc_options" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } ;; esac if test "x$ac_cv_prog_cc_c99" != xno then : ac_prog_cc_stdc=c99 ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 else $as_nop { 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 # AC_CACHE_VAL ac_prog_cc_stdc_options= case "x$ac_cv_prog_cc_c89" in #( x) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } ;; #( xno) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } ;; #( *) : ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c89" CC="$CC$ac_prog_cc_stdc_options" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } ;; esac if test "x$ac_cv_prog_cc_c89" != xno then : ac_prog_cc_stdc=c89 ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 else $as_nop ac_prog_cc_stdc=no ac_cv_prog_cc_stdc=no fi fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 printf %s "checking for inline... " >&6; } if test ${ac_cv_c_inline+y} then : printf %s "(cached) " >&6 else $as_nop ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef __cplusplus typedef int foo_t; static $ac_kw foo_t static_foo (void) {return 0; } $ac_kw foo_t foo (void) {return 0; } #endif _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_c_inline=$ac_kw fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext test "$ac_cv_c_inline" != no && break done fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 printf "%s\n" "$ac_cv_c_inline" >&6; } case $ac_cv_c_inline in inline | yes) ;; *) case $ac_cv_c_inline in no) ac_val=;; *) ac_val=$ac_cv_c_inline;; |
︙ | ︙ | |||
3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 | # - stdlib.h doesn't define strtol or strtoul in some versions # of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- 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 | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | > | | | | < < < | < < < | > | | > | | > | | < < < | < < < | > | | > | | > | | | | | | > | | > | > > > | > | | | | 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 | # - stdlib.h doesn't define strtol or strtoul in some versions # of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- ac_header= ac_cache= for ac_item in $ac_header_c_list do if test $ac_cache; then ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default" if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then printf "%s\n" "#define $ac_item 1" >> confdefs.h fi ac_header= ac_cache= elif test $ac_header; then ac_cache=$ac_item else ac_header=$ac_item fi done if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes then : printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 printf %s "checking how to run the C preprocessor... " >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test ${ac_cv_prog_CPP+y} then : printf %s "(cached) " >&6 else $as_nop # Double quotes because $CC needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" cpp /lib/cpp do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <limits.h> Syntax error _ACEOF if ac_fn_c_try_cpp "$LINENO" then : else $as_nop # Broken: fails on valid input. continue fi rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <ac_nonexistent.h> _ACEOF if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue else $as_nop # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 printf "%s\n" "$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <limits.h> Syntax error _ACEOF if ac_fn_c_try_cpp "$LINENO" then : else $as_nop # Broken: fails on valid input. continue fi rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <ac_nonexistent.h> _ACEOF if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue else $as_nop # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : else $as_nop { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 printf %s "checking for grep that handles long lines and -e... " >&6; } if test ${ac_cv_path_GREP+y} then : printf %s "(cached) " >&6 else $as_nop if test -z "$GREP"; then ac_path_GREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_prog in grep ggrep do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir$ac_prog$ac_exec_ext" as_fn_executable_p "$ac_path_GREP" || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 printf %s 0123456789 >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" printf "%s\n" 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val if test $ac_count -gt ${ac_path_GREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_max=$ac_count |
︙ | ︙ | |||
3539 3540 3541 3542 3543 3544 3545 | as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_GREP=$GREP fi fi | | | | | | > | | > | > > > | > | | | | 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 | as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_GREP=$GREP fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 printf "%s\n" "$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 printf %s "checking for egrep... " >&6; } if test ${ac_cv_path_EGREP+y} then : printf %s "(cached) " >&6 else $as_nop if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else if test -z "$EGREP"; then ac_path_EGREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_prog in egrep do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir$ac_prog$ac_exec_ext" as_fn_executable_p "$ac_path_EGREP" || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 printf %s 0123456789 >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" printf "%s\n" 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val if test $ac_count -gt ${ac_path_EGREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_max=$ac_count |
︙ | ︙ | |||
3606 3607 3608 3609 3610 3611 3612 | fi else ac_cv_path_EGREP=$EGREP fi fi fi | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | > | | | | 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 | fi else ac_cv_path_EGREP=$EGREP fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 printf "%s\n" "$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking dirent.h" >&5 printf %s "checking dirent.h... " >&6; } if test ${tcl_cv_dirent_h+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <dirent.h> int main (void) { #ifndef _POSIX_SOURCE # ifdef __Lynx__ /* * Generate compilation error to make the test fail: Lynx headers * are only valid if really in the POSIX environment. |
︙ | ︙ | |||
3777 3778 3779 3780 3781 3782 3783 | p = entryPtr->d_name; closedir(d); ; return 0; } _ACEOF | | > | | | | | | | > | < | > | | | > | | | | | > | > > > > > > > > > > > > > < < < < < < < < < < < < < | > | | | | | > | | < | | > | | < < < | | < > | < < < | | | > | | | | > | | | | | > < | < | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | | | > | | | | > | | | | | > | | > | < | 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 | p = entryPtr->d_name; closedir(d); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_dirent_h=yes else $as_nop tcl_cv_dirent_h=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_dirent_h" >&5 printf "%s\n" "$tcl_cv_dirent_h" >&6; } if test $tcl_cv_dirent_h = no; then printf "%s\n" "#define NO_DIRENT_H 1" >>confdefs.h fi ac_fn_c_check_header_compile "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default" if test "x$ac_cv_header_stdlib_h" = xyes then : tcl_ok=1 else $as_nop tcl_ok=0 fi cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <stdlib.h> _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtol" >/dev/null 2>&1 then : else $as_nop tcl_ok=0 fi rm -rf conftest* cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <stdlib.h> _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtoul" >/dev/null 2>&1 then : else $as_nop tcl_ok=0 fi rm -rf conftest* if test $tcl_ok = 0; then printf "%s\n" "#define NO_STDLIB_H 1" >>confdefs.h fi ac_fn_c_check_header_compile "$LINENO" "string.h" "ac_cv_header_string_h" "$ac_includes_default" if test "x$ac_cv_header_string_h" = xyes then : tcl_ok=1 else $as_nop tcl_ok=0 fi cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <string.h> _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strstr" >/dev/null 2>&1 then : else $as_nop tcl_ok=0 fi rm -rf conftest* cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <string.h> _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strerror" >/dev/null 2>&1 then : else $as_nop tcl_ok=0 fi rm -rf conftest* # See also memmove check below for a place where NO_STRING_H can be # set and why. if test $tcl_ok = 0; then printf "%s\n" "#define NO_STRING_H 1" >>confdefs.h fi ac_fn_c_check_header_compile "$LINENO" "sys/wait.h" "ac_cv_header_sys_wait_h" "$ac_includes_default" if test "x$ac_cv_header_sys_wait_h" = xyes then : else $as_nop printf "%s\n" "#define NO_SYS_WAIT_H 1" >>confdefs.h fi ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default" if test "x$ac_cv_header_dlfcn_h" = xyes then : else $as_nop printf "%s\n" "#define NO_DLFCN_H 1" >>confdefs.h fi # OS/390 lacks sys/param.h (and doesn't need it, by chance). ac_fn_c_check_header_compile "$LINENO" "sys/param.h" "ac_cv_header_sys_param_h" "$ac_includes_default" if test "x$ac_cv_header_sys_param_h" = xyes then : printf "%s\n" "#define HAVE_SYS_PARAM_H 1" >>confdefs.h fi #-------------------------------------------------------------------- # Determines the correct executable file extension (.exe) #-------------------------------------------------------------------- #------------------------------------------------------------------------ # If we're using GCC, see if the compiler understands -pipe. If so, use it. # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ if test -z "$no_pipe" && test -n "$GCC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -pipe" >&5 printf %s "checking if the compiler understands -pipe... " >&6; } if test ${tcl_cv_cc_pipe+y} then : printf %s "(cached) " >&6 else $as_nop hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cc_pipe=yes else $as_nop tcl_cv_cc_pipe=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext CFLAGS=$hold_cflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_pipe" >&5 printf "%s\n" "$tcl_cv_cc_pipe" >&6; } if test $tcl_cv_cc_pipe = yes; then CFLAGS="$CFLAGS -pipe" fi fi #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ # Check whether --with-encoding was given. if test ${with_encoding+y} then : withval=$with_encoding; with_tcencoding=${withval} fi if test x"${with_tcencoding}" != x ; then printf "%s\n" "#define TCL_CFGVAL_ENCODING \"${with_tcencoding}\"" >>confdefs.h else printf "%s\n" "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h fi #-------------------------------------------------------------------- # Look for libraries that we will need when compiling the Tcl shell #-------------------------------------------------------------------- # The Clang compiler raises a warning for an undeclared identifier that matches # a compiler builtin function. All extant Clang versions are affected, as of # Clang 3.6.0. Test a builtin known to every version. This problem affects the # C and Objective C languages, but Clang does report an error under C++ and # Objective C++. # # Passing -fno-builtin to the compiler would suppress this problem. That # strategy would have the advantage of being insensitive to stray warnings, but # it would make tests less realistic. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how $CC reports undeclared, standard C functions" >&5 printf %s "checking how $CC reports undeclared, standard C functions... " >&6; } if test ${ac_cv_c_decl_report+y} then : printf %s "(cached) " >&6 else $as_nop 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 : if test -s conftest.err then : # For AC_CHECK_DECL to react to warnings, the compiler must be silent on # valid AC_CHECK_DECL input. 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) { #ifdef __cplusplus (void) ac_decl ((int) 0, (char *) 0); (void) ac_decl; #else (void) ac_decl; #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : if test -s conftest.err then : { { 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 detect from compiler exit status or warnings See \`config.log' for more details" "$LINENO" 5; } else $as_nop ac_cv_c_decl_report=warning fi else $as_nop { { 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 compile a simple declaration test See \`config.log' for more details" "$LINENO" 5; } fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext else $as_nop { { 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 $? "compiler does not report undeclared identifiers See \`config.log' for more details" "$LINENO" 5; } fi else $as_nop ac_cv_c_decl_report=error 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_c_decl_report" >&5 printf "%s\n" "$ac_cv_c_decl_report" >&6; } case $ac_cv_c_decl_report in warning) ac_c_decl_warn_flag=yes ;; *) ac_c_decl_warn_flag= ;; esac #-------------------------------------------------------------------- # On a few very rare systems, all of the libm.a stuff is # already in libc.a. Set compiler flags accordingly. #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin" if test "x$ac_cv_func_sin" = xyes then : MATH_LIBS="" else $as_nop MATH_LIBS="-lm" fi #-------------------------------------------------------------------- # Interactive UNIX requires -linet instead of -lsocket, plus it # needs net/errno.h to define the socket-related error codes. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for main in -linet" >&5 printf %s "checking for main in -linet... " >&6; } if test ${ac_cv_lib_inet_main+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { return main (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_inet_main=yes else $as_nop ac_cv_lib_inet_main=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_main" >&5 printf "%s\n" "$ac_cv_lib_inet_main" >&6; } if test "x$ac_cv_lib_inet_main" = xyes then : LIBS="$LIBS -linet" fi ac_fn_c_check_header_compile "$LINENO" "net/errno.h" "ac_cv_header_net_errno_h" "$ac_includes_default" if test "x$ac_cv_header_net_errno_h" = xyes then : printf "%s\n" "#define HAVE_NET_ERRNO_H 1" >>confdefs.h fi #-------------------------------------------------------------------- # Check for the existence of the -lsocket and -lnsl libraries. # The order here is important, so that they end up in the right # order in the command line generated by make. Here are some # special considerations: |
︙ | ︙ | |||
4070 4071 4072 4073 4074 4075 4076 | # 4. On some SVR4 systems, can't use -lsocket without -lnsl too. # To get around this problem, check for both libraries together # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- tcl_checkBoth=0 ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect" | | > | | > | | | | > | | < < < | | > | | | | | > | | > | | > | | | | > | | < < < | | > | | | | | > | | | | | > | | < < < | | > | | | | | > | | | | > | | < < < | | > | | | | | > | | | | > | | < < < | | > | | | | | > | | | | > | | < < < | | > | | | | | > | | | | > | | < < < | | > | | | | | > | | | > | | > | > | > | | < < < | > | < | < | > | | | | > | < < < < < < < < | | | | | | | | > | | | | | | | | > | > | | < | > | | | > | | < < < | | > | > | | > | > | | | | > | | > | | > | | > | > | | < | > | | | > | | < < < | | > | | | | | > | | > | | | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | | | > | | | | | | > | | | | > | | | > | | | | > | | | | | > | | | | | > | | | | | | > | | | | | | | | | > | | < < < | | > | | | | | > | | 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 | # 4. On some SVR4 systems, can't use -lsocket without -lnsl too. # To get around this problem, check for both libraries together # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- tcl_checkBoth=0 ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect" if test "x$ac_cv_func_connect" = xyes then : tcl_checkSocket=0 else $as_nop tcl_checkSocket=1 fi if test "$tcl_checkSocket" = 1; then ac_fn_c_check_func "$LINENO" "setsockopt" "ac_cv_func_setsockopt" if test "x$ac_cv_func_setsockopt" = xyes then : else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for setsockopt in -lsocket" >&5 printf %s "checking for setsockopt in -lsocket... " >&6; } if test ${ac_cv_lib_socket_setsockopt+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char setsockopt (); int main (void) { return setsockopt (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_socket_setsockopt=yes else $as_nop ac_cv_lib_socket_setsockopt=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_setsockopt" >&5 printf "%s\n" "$ac_cv_lib_socket_setsockopt" >&6; } if test "x$ac_cv_lib_socket_setsockopt" = xyes then : LIBS="$LIBS -lsocket" else $as_nop tcl_checkBoth=1 fi fi fi if test "$tcl_checkBoth" = 1; then tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" ac_fn_c_check_func "$LINENO" "accept" "ac_cv_func_accept" if test "x$ac_cv_func_accept" = xyes then : tcl_checkNsl=0 else $as_nop LIBS=$tk_oldLibs fi fi ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname" if test "x$ac_cv_func_gethostbyname" = xyes then : else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5 printf %s "checking for gethostbyname in -lnsl... " >&6; } if test ${ac_cv_lib_nsl_gethostbyname+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lnsl $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char gethostbyname (); int main (void) { return gethostbyname (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_nsl_gethostbyname=yes else $as_nop ac_cv_lib_nsl_gethostbyname=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5 printf "%s\n" "$ac_cv_lib_nsl_gethostbyname" >&6; } if test "x$ac_cv_lib_nsl_gethostbyname" = xyes then : LIBS="$LIBS -lnsl" fi fi printf "%s\n" "#define _REENTRANT 1" >>confdefs.h printf "%s\n" "#define _THREAD_SAFE 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthread" >&5 printf %s "checking for pthread_mutex_init in -lpthread... " >&6; } if test ${ac_cv_lib_pthread_pthread_mutex_init+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main (void) { return pthread_mutex_init (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_pthread_pthread_mutex_init=yes else $as_nop ac_cv_lib_pthread_pthread_mutex_init=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_pthread_pthread_mutex_init" >&6; } if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes then : tcl_ok=yes else $as_nop tcl_ok=no fi if test "$tcl_ok" = "no"; then # Check a little harder for __pthread_mutex_init in the same # library, as some systems hide it there until pthread.h is # defined. We could alternatively do an AC_TRY_COMPILE with # pthread.h, but that will work with libpthread really doesn't # exist, like AIX 4.2. [Bug: 4359] { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __pthread_mutex_init in -lpthread" >&5 printf %s "checking for __pthread_mutex_init in -lpthread... " >&6; } if test ${ac_cv_lib_pthread___pthread_mutex_init+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char __pthread_mutex_init (); int main (void) { return __pthread_mutex_init (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_pthread___pthread_mutex_init=yes else $as_nop ac_cv_lib_pthread___pthread_mutex_init=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_pthread___pthread_mutex_init" >&6; } if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes then : tcl_ok=yes else $as_nop tcl_ok=no fi fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthread" else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthreads" >&5 printf %s "checking for pthread_mutex_init in -lpthreads... " >&6; } if test ${ac_cv_lib_pthreads_pthread_mutex_init+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lpthreads $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main (void) { return pthread_mutex_init (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_pthreads_pthread_mutex_init=yes else $as_nop ac_cv_lib_pthreads_pthread_mutex_init=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; } if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes then : _ok=yes else $as_nop tcl_ok=no fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthreads" else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc" >&5 printf %s "checking for pthread_mutex_init in -lc... " >&6; } if test ${ac_cv_lib_c_pthread_mutex_init+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lc $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main (void) { return pthread_mutex_init (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_c_pthread_mutex_init=yes else $as_nop ac_cv_lib_c_pthread_mutex_init=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_c_pthread_mutex_init" >&6; } if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes then : tcl_ok=yes else $as_nop tcl_ok=no fi if test "$tcl_ok" = "no"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc_r" >&5 printf %s "checking for pthread_mutex_init in -lc_r... " >&6; } if test ${ac_cv_lib_c_r_pthread_mutex_init+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lc_r $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main (void) { return pthread_mutex_init (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_c_r_pthread_mutex_init=yes else $as_nop ac_cv_lib_c_r_pthread_mutex_init=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_c_r_pthread_mutex_init" >&6; } if test "x$ac_cv_lib_c_r_pthread_mutex_init" = xyes then : tcl_ok=yes else $as_nop tcl_ok=no fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -pthread" else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how to find pthread lib on your system - you must edit the LIBS in the Makefile..." >&5 printf "%s\n" "$as_me: WARNING: Don't know how to find pthread lib on your system - you must edit the LIBS in the Makefile..." >&2;} fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" ac_fn_c_check_func "$LINENO" "pthread_attr_setstacksize" "ac_cv_func_pthread_attr_setstacksize" if test "x$ac_cv_func_pthread_attr_setstacksize" = xyes then : printf "%s\n" "#define HAVE_PTHREAD_ATTR_SETSTACKSIZE 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "pthread_atfork" "ac_cv_func_pthread_atfork" if test "x$ac_cv_func_pthread_atfork" = xyes then : printf "%s\n" "#define HAVE_PTHREAD_ATFORK 1" >>confdefs.h fi LIBS=$ac_saved_libs # TIP #509 ac_fn_c_check_decl "$LINENO" "PTHREAD_MUTEX_RECURSIVE" "ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" "#include <pthread.h> " 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 # Add the threads support libraries LIBS="$LIBS$THREADS_LIBS" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5 printf %s "checking how to build libraries... " >&6; } # Check whether --enable-shared was given. if test ${enable_shared+y} then : enableval=$enable_shared; tcl_ok=$enableval else $as_nop tcl_ok=yes fi if test "$tcl_ok" = "yes" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared" >&5 printf "%s\n" "shared" >&6; } SHARED_BUILD=1 else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: static" >&5 printf "%s\n" "static" >&6; } SHARED_BUILD=0 printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h fi #-------------------------------------------------------------------- # Look for a native installed tclsh binary (if available) # If one cannot be found then use the binary we build (fails for # cross compiling). This is used for NATIVE_TCLSH in Makefile. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 printf %s "checking for tclsh... " >&6; } if test ${ac_cv_path_tclsh+y} then : printf %s "(cached) " >&6 else $as_nop search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[8-9]* 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done fi if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5 printf "%s\n" "$TCLSH_PROG" >&6; } else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5 printf "%s\n" "No tclsh found on PATH" >&6; } fi if test "$TCLSH_PROG" = ""; then TCLSH_PROG='./${TCL_EXE}' fi #------------------------------------------------------------------------ # Add stuff for zlib #------------------------------------------------------------------------ zlib_ok=yes ac_fn_c_check_header_compile "$LINENO" "zlib.h" "ac_cv_header_zlib_h" "$ac_includes_default" if test "x$ac_cv_header_zlib_h" = xyes then : ac_fn_c_check_type "$LINENO" "gz_header" "ac_cv_type_gz_header" "#include <zlib.h> " if test "x$ac_cv_type_gz_header" = xyes then : else $as_nop zlib_ok=no fi else $as_nop zlib_ok=no fi if test $zlib_ok = yes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing deflateSetHeader" >&5 printf %s "checking for library containing deflateSetHeader... " >&6; } if test ${ac_cv_search_deflateSetHeader+y} then : printf %s "(cached) " >&6 else $as_nop ac_func_search_save_LIBS=$LIBS cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char deflateSetHeader (); int main (void) { return deflateSetHeader (); ; return 0; } _ACEOF for ac_lib in '' z do if test -z "$ac_lib"; then ac_res="none required" else ac_res=-l$ac_lib LIBS="-l$ac_lib $ac_func_search_save_LIBS" fi if ac_fn_c_try_link "$LINENO" then : ac_cv_search_deflateSetHeader=$ac_res fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext if test ${ac_cv_search_deflateSetHeader+y} then : break fi done if test ${ac_cv_search_deflateSetHeader+y} then : else $as_nop ac_cv_search_deflateSetHeader=no fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_deflateSetHeader" >&5 printf "%s\n" "$ac_cv_search_deflateSetHeader" >&6; } ac_res=$ac_cv_search_deflateSetHeader if test "$ac_res" != no then : test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" else $as_nop zlib_ok=no fi fi if test $zlib_ok = no then : ZLIB_OBJS=\${ZLIB_OBJS} ZLIB_SRCS=\${ZLIB_SRCS} ZLIB_INCLUDE=-I\${ZLIB_DIR} fi printf "%s\n" "#define HAVE_ZLIB 1" >>confdefs.h #------------------------------------------------------------------------ # Add stuff for libtommath libtommath_ok=yes # Check whether --with-system-libtommath was given. if test ${with_system_libtommath+y} then : withval=$with_system_libtommath; libtommath_ok=${withval} fi if test x"${libtommath_ok}" = x -o x"${libtommath_ok}" != xno; then ac_fn_c_check_header_compile "$LINENO" "tommath.h" "ac_cv_header_tommath_h" "$ac_includes_default" if test "x$ac_cv_header_tommath_h" = xyes then : ac_fn_c_check_type "$LINENO" "mp_int" "ac_cv_type_mp_int" "#include <tommath.h> " if test "x$ac_cv_type_mp_int" = xyes then : else $as_nop libtommath_ok=no fi else $as_nop libtommath_ok=no fi if test $libtommath_ok = yes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for mp_log_u32 in -ltommath" >&5 printf %s "checking for mp_log_u32 in -ltommath... " >&6; } if test ${ac_cv_lib_tommath_mp_log_u32+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-ltommath $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char mp_log_u32 (); int main (void) { return mp_log_u32 (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_tommath_mp_log_u32=yes else $as_nop ac_cv_lib_tommath_mp_log_u32=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tommath_mp_log_u32" >&5 printf "%s\n" "$ac_cv_lib_tommath_mp_log_u32" >&6; } if test "x$ac_cv_lib_tommath_mp_log_u32" = xyes then : MATH_LIBS="$MATH_LIBS -ltommath" else $as_nop libtommath_ok=no fi fi fi if test $libtommath_ok = yes then : printf "%s\n" "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h else $as_nop TOMMATH_OBJS=\${TOMMATH_OBJS} TOMMATH_SRCS=\${TOMMATH_SRCS} TOMMATH_INCLUDE=-I\${TOMMATH_DIR} fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_RANLIB+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 printf "%s\n" "$RANLIB" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_RANLIB+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 printf "%s\n" "$ac_ct_RANLIB" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_RANLIB" = x; then RANLIB=":" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac RANLIB=$ac_ct_RANLIB fi else RANLIB="$ac_cv_prog_RANLIB" fi # Step 0.a: Enable 64 bit support? { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5 printf %s "checking if 64bit support is requested... " >&6; } # Check whether --enable-64bit was given. if test ${enable_64bit+y} then : enableval=$enable_64bit; do64bit=$enableval else $as_nop do64bit=no fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 printf "%s\n" "$do64bit" >&6; } # Step 0.b: Enable Solaris 64 bit VIS support? { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if 64bit Sparc VIS support is requested" >&5 printf %s "checking if 64bit Sparc VIS support is requested... " >&6; } # Check whether --enable-64bit-vis was given. if test ${enable_64bit_vis+y} then : enableval=$enable_64bit_vis; do64bitVIS=$enableval else $as_nop do64bitVIS=no fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $do64bitVIS" >&5 printf "%s\n" "$do64bitVIS" >&6; } # Force 64bit on with VIS if test "$do64bitVIS" = "yes" then : do64bit=yes fi # Step 0.c: Check if visibility support is available. Do this here so # that platform specific alternatives can be used below if this fails. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if compiler supports visibility \"hidden\"" >&5 printf %s "checking if compiler supports visibility \"hidden\"... " >&6; } if test ${tcl_cv_cc_visibility_hidden+y} then : printf %s "(cached) " >&6 else $as_nop hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ extern __attribute__((__visibility__("hidden"))) void f(void); void f(void) {} int main (void) { f(); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_visibility_hidden=yes else $as_nop tcl_cv_cc_visibility_hidden=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_visibility_hidden" >&5 printf "%s\n" "$tcl_cv_cc_visibility_hidden" >&6; } if test $tcl_cv_cc_visibility_hidden = yes then : printf "%s\n" "#define MODULE_SCOPE extern __attribute__((__visibility__(\"hidden\")))" >>confdefs.h printf "%s\n" "#define HAVE_HIDDEN 1" >>confdefs.h fi # Step 0.d: Disable -rpath support? { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if rpath support is requested" >&5 printf %s "checking if rpath support is requested... " >&6; } # Check whether --enable-rpath was given. if test ${enable_rpath+y} then : enableval=$enable_rpath; doRpath=$enableval else $as_nop doRpath=yes fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $doRpath" >&5 printf "%s\n" "$doRpath" >&6; } # Step 1: set the variable "system" to hold the name and version number # for the system. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking system version" >&5 printf %s "checking system version... " >&6; } if test ${tcl_cv_sys_version+y} then : printf %s "(cached) " >&6 else $as_nop if test "${TEA_PLATFORM}" = "windows" ; then tcl_cv_sys_version=windows else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5 printf "%s\n" "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then tcl_cv_sys_version=NetBSD-Debian fi fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 printf "%s\n" "$tcl_cv_sys_version" >&6; } system=$tcl_cv_sys_version # Step 2: check for existence of -ldl library. This is needed because # Linux can use either -ldl or -ldld for dynamic loading. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 printf %s "checking for dlopen in -ldl... " >&6; } if test ${ac_cv_lib_dl_dlopen+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char dlopen (); int main (void) { return dlopen (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_dl_dlopen=yes else $as_nop ac_cv_lib_dl_dlopen=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 printf "%s\n" "$ac_cv_lib_dl_dlopen" >&6; } if test "x$ac_cv_lib_dl_dlopen" = xyes then : have_dl=yes else $as_nop have_dl=no fi # Require ranlib early so we can override it in special cases below. |
︙ | ︙ | |||
5029 5030 5031 5032 5033 5034 5035 | # is disabled by the user. [Bug 1016796] LDFLAGS_ARCH="" UNSHARED_LIB_SUFFIX="" TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`' ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g | | > | | | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | > | > | | | > | > | | | | > | > | | | > | | 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 | # is disabled by the user. [Bug 1016796] LDFLAGS_ARCH="" UNSHARED_LIB_SUFFIX="" TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`' ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g if test "$GCC" = yes then : CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith" case "${CC}" in *++|*++-*) ;; *) CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -fextended-identifiers" ;; esac else $as_nop CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_AR+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_AR="${ac_tool_prefix}ar" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 printf "%s\n" "$AR" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_AR+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AR="ar" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 printf "%s\n" "$ac_ct_AR" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_AR" = x; then AR="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac AR=$ac_ct_AR fi else AR="$ac_cv_prog_AR" fi STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" if test "x${SHLIB_VERSION}" = x then : SHLIB_VERSION="1.0" fi case $system in AIX-*) if test "$GCC" != "yes" then : # AIX requires the _r compiler when gcc isn't being used case "${CC}" in *_r|*_r\ *) # ok ... ;; *) # Make sure only first arg gets _r CC=`echo "$CC" | sed -e 's/^\([^ ]*\)/\1_r/'` ;; esac { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using $CC for compiling with threads" >&5 printf "%s\n" "Using $CC for compiling with threads" >&6; } fi LIBS="$LIBS -lc" SHLIB_CFLAGS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" LD_LIBRARY_PATH_VAR="LIBPATH" # ldAix No longer needed with use of -bexpall/-brtl # but some extensions may still reference it LDAIX_SRC='$(UNIX_DIR)/ldAix' # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes then : if test "$GCC" = yes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} else $as_nop do64bit_ok=yes CFLAGS="$CFLAGS -q64" LDFLAGS_ARCH="-q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" fi fi if test "`uname -m`" = ia64 then : # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC SHLIB_LD="/usr/ccs/bin/ld -G -z text" # AIX-5 has dl* in libc.so DL_LIBS="" if test "$GCC" = yes then : CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' else $as_nop CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' fi LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' else $as_nop if test "$GCC" = yes then : SHLIB_LD='${CC} -shared -Wl,-bexpall' else $as_nop SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" LDFLAGS="$LDFLAGS -brtl" fi SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" |
︙ | ︙ | |||
5246 5247 5248 5249 5250 5251 5252 | DL_LIBS="-ldl" #----------------------------------------------------------- # Check for inet_ntoa in -lbind, for BeOS (which also needs # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- | | | | > | | < < < | | > | | | | | > | 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 | DL_LIBS="-ldl" #----------------------------------------------------------- # Check for inet_ntoa in -lbind, for BeOS (which also needs # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lbind" >&5 printf %s "checking for inet_ntoa in -lbind... " >&6; } if test ${ac_cv_lib_bind_inet_ntoa+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lbind $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main (void) { return inet_ntoa (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_bind_inet_ntoa=yes else $as_nop ac_cv_lib_bind_inet_ntoa=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bind_inet_ntoa" >&5 printf "%s\n" "$ac_cv_lib_bind_inet_ntoa" >&6; } if test "x$ac_cv_lib_bind_inet_ntoa" = xyes then : LIBS="$LIBS -lbind -lsocket" fi ;; BSD/OS-2.1*|BSD/OS-3*) SHLIB_CFLAGS="" SHLIB_LD="shlicc -r" |
︙ | ︙ | |||
5306 5307 5308 5309 5310 5311 5312 | SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; | | | | | > | | | | > | | | | | 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 | SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32_*|MSYS_*) SHLIB_CFLAGS="-fno-common" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\[email protected]" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for Cygwin version of gcc" >&5 printf %s "checking for Cygwin version of gcc... " >&6; } if test ${ac_cv_cygwin+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __CYGWIN__ #error cygwin #endif int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_cygwin=no else $as_nop ac_cv_cygwin=yes 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_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" # The eval makes quoting arguments work. |
︙ | ︙ | |||
5380 5381 5382 5383 5384 5385 5386 | Haiku*) LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" | | | | > | | < < < | | > | | | | | > | | | > | | | | > | | < < < | | > | | | | | > | | > | > | | > | > | > | | | | | | > | | < < < | | > | | | | | > | | > | 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 | Haiku*) LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lnetwork" >&5 printf %s "checking for inet_ntoa in -lnetwork... " >&6; } if test ${ac_cv_lib_network_inet_ntoa+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lnetwork $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main (void) { return inet_ntoa (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_network_inet_ntoa=yes else $as_nop ac_cv_lib_network_inet_ntoa=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_network_inet_ntoa" >&5 printf "%s\n" "$ac_cv_lib_network_inet_ntoa" >&6; } if test "x$ac_cv_lib_network_inet_ntoa" = xyes then : LIBS="$LIBS -lnetwork" fi ;; HP-UX-*.11.*) # Use updated header definitions where possible printf "%s\n" "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h printf "%s\n" "#define _XOPEN_SOURCE 1" >>confdefs.h LIBS="$LIBS -lxnet" # Use the XOPEN network library if test "`uname -m`" = ia64 then : SHLIB_SUFFIX=".so" else $as_nop SHLIB_SUFFIX=".sl" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 printf %s "checking for shl_load in -ldld... " >&6; } if test ${ac_cv_lib_dld_shl_load+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char shl_load (); int main (void) { return shl_load (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_dld_shl_load=yes else $as_nop ac_cv_lib_dld_shl_load=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 printf "%s\n" "$ac_cv_lib_dld_shl_load" >&6; } if test "x$ac_cv_lib_dld_shl_load" = xyes then : tcl_ok=yes else $as_nop tcl_ok=no fi if test "$tcl_ok" = yes then : SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi if test "$GCC" = yes then : SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} else $as_nop CFLAGS="$CFLAGS -z" fi # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc #CFLAGS="$CFLAGS +DAportable" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = "yes" then : if test "$GCC" = yes then : case `${CC} -dumpmachine` in hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' if test $doRpath = yes then : CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} ;; esac else $as_nop do64bit_ok=yes CFLAGS="$CFLAGS +DD64" LDFLAGS_ARCH="+DD64" fi fi ;; HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 printf %s "checking for shl_load in -ldld... " >&6; } if test ${ac_cv_lib_dld_shl_load+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char shl_load (); int main (void) { return shl_load (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_dld_shl_load=yes else $as_nop ac_cv_lib_dld_shl_load=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 printf "%s\n" "$ac_cv_lib_dld_shl_load" >&6; } if test "x$ac_cv_lib_dld_shl_load" = xyes then : tcl_ok=yes else $as_nop tcl_ok=no fi if test "$tcl_ok" = yes then : SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" SHLIB_LD_LIBS="" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" |
︙ | ︙ | |||
5608 5609 5610 5611 5612 5613 5614 | DL_LIBS="" case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac | | > | > | > | | 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 | DL_LIBS="" case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac if test $doRpath = yes then : CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi ;; IRIX-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac if test $doRpath = yes then : CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes then : CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" else $as_nop case $system in IRIX-6.3) # Use to build 6.2 compatible binaries on 6.3. CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" ;; *) |
︙ | ︙ | |||
5663 5664 5665 5666 5667 5668 5669 | DL_LIBS="" case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac | | > | > | > | | | | 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 | DL_LIBS="" case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac if test $doRpath = yes then : CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes then : if test "$GCC" = yes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} else $as_nop do64bit_ok=yes SHLIB_LD="ld -64 -shared -rdata_shared" CFLAGS="$CFLAGS -64" LDFLAGS_ARCH="-64" fi |
︙ | ︙ | |||
5703 5704 5705 5706 5707 5708 5709 | # 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" | | > | > | > | | | > | | | | > | | | | | > | > | > | > | 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 6345 6346 6347 6348 6349 6350 6351 6352 6353 6354 6355 6356 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 6377 6378 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 | # 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" 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" then : CFLAGS="$CFLAGS -mieee" fi if test $do64bit = yes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -m64 flag" >&5 printf %s "checking if compiler accepts -m64 flag... " >&6; } if test ${tcl_cv_cc_m64+y} then : printf %s "(cached) " >&6 else $as_nop hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_m64=yes else $as_nop tcl_cv_cc_m64=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_m64" >&5 printf "%s\n" "$tcl_cv_cc_m64" >&6; } if test $tcl_cv_cc_m64 = yes then : CFLAGS="$CFLAGS -m64" do64bit_ok=yes fi fi # The combo of gcc + glibc has a bug related to inlining of # functions like strtol()/strtoul(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. if test x"${USE_COMPAT}" != x then : CFLAGS="$CFLAGS -fno-inline" fi ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE=-02 SHLIB_LD='${CC} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" if test $doRpath = yes then : CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi ;; OpenBSD-*) arch=`arch -s` case "$arch" in alpha|sparc64) SHLIB_CFLAGS="-fPIC" ;; *) SHLIB_CFLAGS="-fpic" ;; esac SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes then : CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" CFLAGS_OPTIMIZE="-O2" |
︙ | ︙ | |||
5814 5815 5816 5817 5818 5819 5820 | # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" | | > | > | 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 | # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" if test $doRpath = yes then : CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' 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" ;; DragonFly-*|FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_LD="${CC} -shared" SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes then : CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" |
︙ | ︙ | |||
5862 5863 5864 5865 5866 5867 5868 | # -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}'`" | | > | | | > | | | | > | | | | | > | | | > | | | | > | | | | | > | | | | > | | | > | | | | > | | | | | > | | | > | | | | > | | | | | > | > | | | | | > | | | | > | | | > | | | > | | > | | | > | | | > | | | > | | | > | | | | > | | | | | > | | | > | | > | > | | > | | 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 6470 6471 6472 6473 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 6498 6499 6500 6501 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 6550 6551 6552 6553 6554 6555 6556 6557 6558 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 6578 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 6617 6618 6619 6620 6621 6622 6623 6624 6625 6626 6627 6628 6629 6630 6631 6632 6633 6634 6635 6636 6637 6638 6639 6640 6641 6642 6643 6644 6645 6646 6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 6663 6664 6665 6666 6667 6668 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 6715 6716 6717 6718 6719 6720 6721 6722 6723 6724 6725 6726 6727 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 6783 6784 6785 6786 6787 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 6817 6818 6819 6820 6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 6831 6832 6833 6834 6835 6836 6837 | # -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}'`" if test $do64bit = yes then : case `arch` in ppc) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch ppc64 flag" >&5 printf %s "checking if compiler accepts -arch ppc64 flag... " >&6; } if test ${tcl_cv_cc_arch_ppc64+y} then : printf %s "(cached) " >&6 else $as_nop hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_arch_ppc64=yes else $as_nop tcl_cv_cc_arch_ppc64=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_ppc64" >&5 printf "%s\n" "$tcl_cv_cc_arch_ppc64" >&6; } if test $tcl_cv_cc_arch_ppc64 = yes then : CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" do64bit_ok=yes fi;; i386) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch x86_64 flag" >&5 printf %s "checking if compiler accepts -arch x86_64 flag... " >&6; } if test ${tcl_cv_cc_arch_x86_64+y} then : printf %s "(cached) " >&6 else $as_nop hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_arch_x86_64=yes else $as_nop tcl_cv_cc_arch_x86_64=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_x86_64" >&5 printf "%s\n" "$tcl_cv_cc_arch_x86_64" >&6; } if test $tcl_cv_cc_arch_x86_64 = yes then : CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes fi;; *) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 printf "%s\n" "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; esac else $as_nop # Check for combined 32-bit and 64-bit fat build if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) ' then : fat_32_64=yes fi fi SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if ld accepts -single_module flag" >&5 printf %s "checking if ld accepts -single_module flag... " >&6; } if test ${tcl_cv_ld_single_module+y} then : printf %s "(cached) " >&6 else $as_nop hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { int i; ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_ld_single_module=yes else $as_nop tcl_cv_ld_single_module=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_single_module" >&5 printf "%s\n" "$tcl_cv_ld_single_module" >&6; } if test $tcl_cv_ld_single_module = yes then : SHLIB_LD="${SHLIB_LD} -Wl,-single_module" fi SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" DL_LIBS="" LDFLAGS="$LDFLAGS -headerpad_max_install_names" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if ld accepts -search_paths_first flag" >&5 printf %s "checking if ld accepts -search_paths_first flag... " >&6; } if test ${tcl_cv_ld_search_paths_first+y} then : printf %s "(cached) " >&6 else $as_nop hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { int i; ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_ld_search_paths_first=yes else $as_nop tcl_cv_ld_search_paths_first=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_search_paths_first" >&5 printf "%s\n" "$tcl_cv_ld_search_paths_first" >&6; } if test $tcl_cv_ld_search_paths_first = yes then : LDFLAGS="$LDFLAGS -Wl,-search_paths_first" fi if test "$tcl_cv_cc_visibility_hidden" != yes then : printf "%s\n" "#define MODULE_SCOPE __private_extern__" >>confdefs.h tcl_cv_cc_visibility_hidden=yes fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" printf "%s\n" "#define MAC_OSX_TCL 1" >>confdefs.h PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use CoreFoundation" >&5 printf %s "checking whether to use CoreFoundation... " >&6; } # Check whether --enable-corefoundation was given. if test ${enable_corefoundation+y} then : enableval=$enable_corefoundation; tcl_corefoundation=$enableval else $as_nop tcl_corefoundation=yes fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_corefoundation" >&5 printf "%s\n" "$tcl_corefoundation" >&6; } if test $tcl_corefoundation = yes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for CoreFoundation.framework" >&5 printf %s "checking for CoreFoundation.framework... " >&6; } if test ${tcl_cv_lib_corefoundation+y} then : printf %s "(cached) " >&6 else $as_nop hold_libs=$LIBS if test "$fat_32_64" = yes then : for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit # archs from CFLAGS et al. while testing for # presence of CF. 64-bit CF is disabled in # tclUnixPort.h if necessary. eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done fi LIBS="$LIBS -framework CoreFoundation" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <CoreFoundation/CoreFoundation.h> int main (void) { CFBundleRef b = CFBundleGetMainBundle(); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_lib_corefoundation=yes else $as_nop tcl_cv_lib_corefoundation=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext if test "$fat_32_64" = yes then : for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi LIBS=$hold_libs fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation" >&5 printf "%s\n" "$tcl_cv_lib_corefoundation" >&6; } if test $tcl_cv_lib_corefoundation = yes then : LIBS="$LIBS -framework CoreFoundation" printf "%s\n" "#define HAVE_COREFOUNDATION 1" >>confdefs.h else $as_nop tcl_corefoundation=no fi if test "$fat_32_64" = yes -a $tcl_corefoundation = yes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for 64-bit CoreFoundation" >&5 printf %s "checking for 64-bit CoreFoundation... " >&6; } if test ${tcl_cv_lib_corefoundation_64+y} then : printf %s "(cached) " >&6 else $as_nop for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <CoreFoundation/CoreFoundation.h> int main (void) { CFBundleRef b = CFBundleGetMainBundle(); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_lib_corefoundation_64=yes else $as_nop tcl_cv_lib_corefoundation_64=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation_64" >&5 printf "%s\n" "$tcl_cv_lib_corefoundation_64" >&6; } if test $tcl_cv_lib_corefoundation_64 = no then : printf "%s\n" "#define NO_COREFOUNDATION_64 1" >>confdefs.h LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" fi fi fi ;; OS/390-*) SHLIB_LD_LIBS="" CFLAGS_OPTIMIZE="" # Optimizer is buggy printf "%s\n" "#define _OE_SOCKETS 1" >>confdefs.h ;; OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" if test "$SHARED_BUILD" = 1 then : SHLIB_LD='ld -shared -expect_unresolved "*"' else $as_nop SHLIB_LD='ld -non_shared -expect_unresolved "*"' fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes then : CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes then : CFLAGS="$CFLAGS -mieee" else $as_nop CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" fi # see pthread_intro(3) for pthread support on osf1, k.furukawa CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" LIBS=`echo $LIBS | sed s/-lpthreads//` if test "$GCC" = yes then : LIBS="$LIBS -lpthread -lmach -lexc" else $as_nop CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" fi ;; QNX-6*) |
︙ | ︙ | |||
6226 6227 6228 6229 6230 6231 6232 | CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SCO_SV-3.2*) # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. | | > | | | | > | | | | > | > | > | > | | | | | > | | | > | > | | | | | | | > | | | | > | | | | > < | | | | > | > | > | | > | | > | | 6846 6847 6848 6849 6850 6851 6852 6853 6854 6855 6856 6857 6858 6859 6860 6861 6862 6863 6864 6865 6866 6867 6868 6869 6870 6871 6872 6873 6874 6875 6876 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931 6932 6933 6934 6935 6936 6937 6938 6939 6940 6941 6942 6943 6944 6945 6946 6947 6948 6949 6950 6951 6952 6953 6954 6955 6956 6957 6958 6959 6960 6961 6962 6963 6964 6965 6966 6967 6968 6969 6970 6971 6972 6973 6974 6975 6976 6977 6978 6979 6980 6981 6982 6983 6984 6985 6986 6987 6988 6989 6990 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 7006 7007 7008 7009 7010 7011 7012 7013 7014 7015 7016 7017 7018 7019 7020 7021 7022 7023 7024 7025 7026 7027 7028 7029 7030 7031 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046 7047 7048 7049 7050 7051 7052 7053 7054 7055 7056 7057 7058 7059 7060 7061 7062 7063 7064 7065 7066 7067 7068 7069 7070 7071 7072 7073 7074 7075 7076 7077 7078 7079 7080 7081 7082 7083 7084 | CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SCO_SV-3.2*) # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. if test "$GCC" = yes then : SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" else $as_nop SHLIB_CFLAGS="-Kpic -belf" LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" fi SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SunOS-5.[0-6]) # Careful to not let 5.10+ fall into this case # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. printf "%s\n" "#define _REENTRANT 1" >>confdefs.h printf "%s\n" "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h SHLIB_CFLAGS="-KPIC" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" if test "$GCC" = yes then : SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} else $as_nop SHLIB_LD="/usr/ccs/bin/ld -G -z text" CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi ;; SunOS-5*) # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. printf "%s\n" "#define _REENTRANT 1" >>confdefs.h printf "%s\n" "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h SHLIB_CFLAGS="-KPIC" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes then : arch=`isainfo` if test "$arch" = "sparcv9 sparc" then : if test "$GCC" = yes then : if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3 then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} else $as_nop do64bit_ok=yes CFLAGS="$CFLAGS -m64 -mcpu=v9" LDFLAGS="$LDFLAGS -m64 -mcpu=v9" SHLIB_CFLAGS="-fPIC" fi else $as_nop do64bit_ok=yes if test "$do64bitVIS" = yes then : CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS_ARCH="-xarch=v9a" else $as_nop CFLAGS="$CFLAGS -xarch=v9" LDFLAGS_ARCH="-xarch=v9" fi # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" fi else $as_nop if test "$arch" = "amd64 i386" then : if test "$GCC" = yes then : case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) do64bit_ok=yes CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; esac else $as_nop do64bit_ok=yes case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) CFLAGS="$CFLAGS -xarch=amd64" LDFLAGS="$LDFLAGS -xarch=amd64";; esac fi else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported for $arch" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} fi fi fi #-------------------------------------------------------------------- # On Solaris 5.x i386 with the sunpro compiler we need to link # with sunmath to get floating point rounding control #-------------------------------------------------------------------- if test "$GCC" = yes then : use_sunmath=no else $as_nop arch=`isainfo` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use -lsunmath for fp rounding control" >&5 printf %s "checking whether to use -lsunmath for fp rounding control... " >&6; } if test "$arch" = "amd64 i386" -o "$arch" = "i386" then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } MATH_LIBS="-lsunmath $MATH_LIBS" ac_fn_c_check_header_compile "$LINENO" "sunmath.h" "ac_cv_header_sunmath_h" "$ac_includes_default" if test "x$ac_cv_header_sunmath_h" = xyes then : fi use_sunmath=yes else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } use_sunmath=no fi fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" if test "$GCC" = yes then : SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "$do64bit_ok" = yes then : if test "$arch" = "sparcv9 sparc" then : # We need to specify -static-libgcc or we need to # add the path to the sparv9 libgcc. SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" # for finding sparcv9 libgcc, get the regular libgcc # path, remove so name and append 'sparcv9' #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" else $as_nop if test "$arch" = "amd64 i386" then : SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" fi fi fi else $as_nop if test "$use_sunmath" = yes then : textmode=textoff else $as_nop textmode=text fi case $system in SunOS-5.[1-9][0-9]*|SunOS-5.[7-9]) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; |
︙ | ︙ | |||
6457 6458 6459 6460 6461 6462 6463 | SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. | | | | > | | | | > | | | | | > | > | | | > | | > | | > | > | | | | > | | | > | | > | > | > | > | | | > | | > | | > | | | | | | > | | | | | | > | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > | | > | < | 7093 7094 7095 7096 7097 7098 7099 7100 7101 7102 7103 7104 7105 7106 7107 7108 7109 7110 7111 7112 7113 7114 7115 7116 7117 7118 7119 7120 7121 7122 7123 7124 7125 7126 7127 7128 7129 7130 7131 7132 7133 7134 7135 7136 7137 7138 7139 7140 7141 7142 7143 7144 7145 7146 7147 7148 7149 7150 7151 7152 7153 7154 7155 7156 7157 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 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 7195 7196 7197 7198 7199 7200 7201 7202 7203 7204 7205 7206 7207 7208 7209 7210 7211 7212 7213 7214 7215 7216 7217 7218 7219 7220 7221 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 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 7289 7290 7291 7292 7293 7294 7295 7296 7297 7298 7299 7300 7301 7302 7303 7304 7305 7306 7307 7308 7309 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 7336 7337 7338 7339 7340 7341 7342 7343 7344 7345 7346 7347 7348 7349 7350 7351 7352 7353 7354 7355 7356 7357 7358 7359 7360 7361 7362 7363 7364 7365 7366 7367 7368 7369 7370 7371 7372 7373 7374 7375 7376 7377 7378 7379 7380 7381 7382 7383 7384 7385 7386 7387 7388 7389 7390 7391 7392 7393 7394 7395 7396 7397 7398 7399 7400 7401 7402 7403 7404 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 | SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for ld accepts -Bexport flag" >&5 printf %s "checking for ld accepts -Bexport flag... " >&6; } if test ${tcl_cv_ld_Bexport+y} then : printf %s "(cached) " >&6 else $as_nop hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { int i; ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_ld_Bexport=yes else $as_nop tcl_cv_ld_Bexport=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5 printf "%s\n" "$tcl_cv_ld_Bexport" >&6; } if test $tcl_cv_ld_Bexport = yes then : LDFLAGS="$LDFLAGS -Wl,-Bexport" fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; esac if test "$do64bit" = yes -a "$do64bit_ok" = no then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 printf "%s\n" "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} fi if test "$do64bit" = yes -a "$do64bit_ok" = yes then : printf "%s\n" "#define TCL_CFG_DO64BIT 1" >>confdefs.h fi # Step 4: disable dynamic loading if requested via a command-line switch. # Check whether --enable-load was given. if test ${enable_load+y} then : enableval=$enable_load; tcl_ok=$enableval else $as_nop tcl_ok=yes fi if test "$tcl_ok" = no then : DL_OBJS="" fi if test "x$DL_OBJS" != x then : BUILD_DLTEST="\$(DLTEST_TARGETS)" else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5 printf "%s\n" "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;} SHLIB_CFLAGS="" SHLIB_LD="" SHLIB_SUFFIX="" DL_OBJS="tclLoadNone.o" DL_LIBS="" LDFLAGS="$LDFLAGS_ORIG" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" BUILD_DLTEST="" fi LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" # If we're running gcc, then change the C flags for compiling shared # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. 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-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; OSF1-V*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac fi if test "$tcl_cv_cc_visibility_hidden" != yes then : printf "%s\n" "#define MODULE_SCOPE extern" >>confdefs.h fi if test "$SHARED_LIB_SUFFIX" = "" then : SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}' fi if test "$UNSHARED_LIB_SUFFIX" = "" then : UNSHARED_LIB_SUFFIX='${VERSION}.a' fi DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != "" then : LIB_SUFFIX=${SHARED_LIB_SUFFIX} MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' if test "${SHLIB_SUFFIX}" = ".dll" then : INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" else $as_nop INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' fi else $as_nop LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} if test "$RANLIB" = "" then : MAKE_LIB='$(STLIB_LD) $@ ${OBJS}' else $as_nop MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@' fi INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' fi # Stub lib does not depend on shared/static configuration if test "$RANLIB" = "" then : MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}' else $as_nop MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@' fi INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. if test "x${TCL_LIBS}" = x then : TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}" fi # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5 printf %s "checking for cast to union support... " >&6; } if test ${tcl_cv_cast_to_union+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { union foo { int i; double d; }; union foo f = (union foo) (int) 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cast_to_union=yes else $as_nop tcl_cv_cast_to_union=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_cast_to_union" >&5 printf "%s\n" "$tcl_cv_cast_to_union" >&6; } if test "$tcl_cv_cast_to_union" = "yes"; then printf "%s\n" "#define HAVE_CAST_TO_UNION 1" >>confdefs.h fi 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 /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_nolto=yes else $as_nop ac_cv_nolto=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_nolto" >&5 printf "%s\n" "$ac_cv_nolto" >&6; } CFLAGS=$hold_cflags if test "$ac_cv_nolto" = "yes" ; then CFLAGS_NOLTO="-fno-lto" else CFLAGS_NOLTO="" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -finput-charset" >&5 printf %s "checking if the compiler understands -finput-charset... " >&6; } if test ${tcl_cv_cc_input_charset+y} then : printf %s "(cached) " >&6 else $as_nop hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cc_input_charset=yes else $as_nop tcl_cv_cc_input_charset=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext CFLAGS=$hold_cflags 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 CFLAGS="$CFLAGS -finput-charset=UTF-8" fi ac_fn_c_check_header_compile "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default" if test "x$ac_cv_header_stdbool_h" = xyes then : printf "%s\n" "#define HAVE_STDBOOL_H 1" >>confdefs.h fi # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. |
︙ | ︙ | |||
6714 6715 6716 6717 6718 6719 6720 |
| | | < | | | > | | | | | | | | | | | | | | | | | | > | | | | > | | | > | | | | | > | | | | > | | | > | | | | | > | | | | > | | | > | | | | | | | | | | | > | | < < < < < < < < < < < < < < < < < < | | | > | | | | | < < < < < < < < | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | | > | | | | > | | | | | > | | > | > | > | | < < < | | | > | | | | > | | | | | | | | | | > | | | > | 7437 7438 7439 7440 7441 7442 7443 7444 7445 7446 7447 7448 7449 7450 7451 7452 7453 7454 7455 7456 7457 7458 7459 7460 7461 7462 7463 7464 7465 7466 7467 7468 7469 7470 7471 7472 7473 7474 7475 7476 7477 7478 7479 7480 7481 7482 7483 7484 7485 7486 7487 7488 7489 7490 7491 7492 7493 7494 7495 7496 7497 7498 7499 7500 7501 7502 7503 7504 7505 7506 7507 7508 7509 7510 7511 7512 7513 7514 7515 7516 7517 7518 7519 7520 7521 7522 7523 7524 7525 7526 7527 7528 7529 7530 7531 7532 7533 7534 7535 7536 7537 7538 7539 7540 7541 7542 7543 7544 7545 7546 7547 7548 7549 7550 7551 7552 7553 7554 7555 7556 7557 7558 7559 7560 7561 7562 7563 7564 7565 7566 7567 7568 7569 7570 7571 7572 7573 7574 7575 7576 7577 7578 7579 7580 7581 7582 7583 7584 7585 7586 7587 7588 7589 7590 7591 7592 7593 7594 7595 7596 7597 7598 7599 7600 7601 7602 7603 7604 7605 7606 7607 7608 7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 7621 7622 7623 7624 7625 7626 7627 7628 7629 7630 7631 7632 7633 7634 7635 7636 7637 7638 7639 7640 7641 7642 7643 7644 7645 7646 7647 7648 7649 7650 7651 7652 7653 7654 7655 7656 7657 7658 7659 7660 7661 7662 7663 7664 7665 7666 7667 7668 7669 7670 7671 7672 7673 7674 7675 7676 7677 7678 7679 7680 7681 7682 7683 7684 7685 7686 7687 7688 7689 7690 7691 7692 7693 7694 7695 7696 7697 7698 7699 7700 7701 7702 7703 7704 7705 7706 7707 7708 7709 7710 7711 7712 7713 7714 7715 7716 7717 7718 7719 7720 7721 7722 7723 7724 7725 7726 7727 7728 7729 7730 7731 7732 7733 7734 7735 7736 7737 7738 7739 7740 7741 7742 7743 7744 7745 7746 7747 7748 7749 7750 7751 7752 7753 7754 7755 7756 7757 7758 7759 7760 7761 7762 7763 7764 7765 7766 7767 7768 7769 7770 7771 7772 7773 7774 7775 7776 7777 7778 7779 7780 7781 7782 7783 7784 7785 7786 7787 7788 7789 7790 7791 7792 7793 7794 7795 7796 7797 7798 7799 7800 7801 7802 7803 7804 7805 7806 7807 7808 7809 7810 7811 7812 7813 7814 7815 7816 7817 7818 7819 7820 7821 7822 7823 7824 7825 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 7852 7853 7854 7855 7856 7857 7858 7859 7860 7861 7862 7863 7864 7865 7866 7867 7868 7869 7870 7871 7872 7873 7874 7875 7876 7877 7878 7879 7880 7881 7882 7883 7884 7885 7886 7887 7888 7889 7890 7891 7892 7893 7894 7895 7896 7897 7898 7899 7900 7901 7902 7903 7904 7905 7906 7907 7908 7909 7910 7911 7912 7913 7914 7915 7916 7917 7918 | printf "%s\n" "#define TCL_SHLIB_EXT \"${SHLIB_SUFFIX}\"" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5 printf %s "checking for build with symbols... " >&6; } # Check whether --enable-symbols was given. if test ${enable_symbols+y} then : enableval=$enable_symbols; tcl_ok=$enableval else $as_nop tcl_ok=no fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' printf "%s\n" "#define NDEBUG 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } printf "%s\n" "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' if test "$tcl_ok" = "yes"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5 printf "%s\n" "yes (standard debugging)" >&6; } fi fi if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then printf "%s\n" "#define TCL_MEM_DEBUG 1" >>confdefs.h fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then printf "%s\n" "#define TCL_COMPILE_DEBUG 1" >>confdefs.h printf "%s\n" "#define TCL_COMPILE_STATS 1" >>confdefs.h fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5 printf "%s\n" "enabled symbols mem compile debugging" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5 printf "%s\n" "enabled $tcl_ok debugging" >&6; } fi fi printf "%s\n" "#define MP_PREC 4" >>confdefs.h #-------------------------------------------------------------------- # Detect what compiler flags to set for 64-bit support. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for required early compiler flags" >&5 printf %s "checking for required early compiler flags... " >&6; } tcl_flags="" if test ${tcl_cv_flag__isoc99_source+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <stdlib.h> int main (void) { char *p = (char *)strtoll; char *q = (char *)strtoull; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__isoc99_source=no else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define _ISOC99_SOURCE 1 #include <stdlib.h> int main (void) { char *p = (char *)strtoll; char *q = (char *)strtoull; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__isoc99_source=yes else $as_nop tcl_cv_flag__isoc99_source=no 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 fi if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then printf "%s\n" "#define _ISOC99_SOURCE 1" >>confdefs.h tcl_flags="$tcl_flags _ISOC99_SOURCE" fi if test ${tcl_cv_flag__largefile64_source+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/stat.h> int main (void) { struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__largefile64_source=no else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define _LARGEFILE64_SOURCE 1 #include <sys/stat.h> int main (void) { struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__largefile64_source=yes else $as_nop tcl_cv_flag__largefile64_source=no 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 fi if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then printf "%s\n" "#define _LARGEFILE64_SOURCE 1" >>confdefs.h tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" fi if test ${tcl_cv_flag__largefile_source64+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/stat.h> int main (void) { char *p = (char *)open64; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__largefile_source64=no else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define _LARGEFILE_SOURCE64 1 #include <sys/stat.h> int main (void) { char *p = (char *)open64; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__largefile_source64=yes else $as_nop tcl_cv_flag__largefile_source64=no 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 fi if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then printf "%s\n" "#define _LARGEFILE_SOURCE64 1" >>confdefs.h tcl_flags="$tcl_flags _LARGEFILE_SOURCE64" fi if test "x${tcl_flags}" = "x" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none" >&5 printf "%s\n" "none" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5 printf "%s\n" "${tcl_flags}" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for 64-bit integer type" >&5 printf %s "checking for 64-bit integer type... " >&6; } if test ${tcl_cv_type_64bit+y} then : printf %s "(cached) " >&6 else $as_nop tcl_cv_type_64bit=none # See if we could use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { switch (0) { case 1: case (sizeof(long long)==sizeof(long)): ; } ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_type_64bit="long long" fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi if test "${tcl_cv_type_64bit}" = none ; then printf "%s\n" "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else # Now check for auxiliary declarations { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5 printf %s "checking for struct dirent64... " >&6; } if test ${tcl_cv_struct_dirent64+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <dirent.h> int main (void) { struct dirent64 p; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_struct_dirent64=yes else $as_nop tcl_cv_struct_dirent64=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_struct_dirent64" >&5 printf "%s\n" "$tcl_cv_struct_dirent64" >&6; } if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then printf "%s\n" "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for DIR64" >&5 printf %s "checking for DIR64... " >&6; } if test ${tcl_cv_DIR64+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <dirent.h> int main (void) { struct dirent64 *p; DIR64 d = opendir64("."); p = readdir64(d); rewinddir64(d); closedir64(d); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_DIR64=yes else $as_nop tcl_cv_DIR64=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_DIR64" >&5 printf "%s\n" "$tcl_cv_DIR64" >&6; } if test "x${tcl_cv_DIR64}" = "xyes" ; then printf "%s\n" "#define HAVE_DIR64 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5 printf %s "checking for struct stat64... " >&6; } if test ${tcl_cv_struct_stat64+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/stat.h> int main (void) { struct stat64 p; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_struct_stat64=yes else $as_nop tcl_cv_struct_stat64=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_struct_stat64" >&5 printf "%s\n" "$tcl_cv_struct_stat64" >&6; } if test "x${tcl_cv_struct_stat64}" = "xyes" ; then printf "%s\n" "#define HAVE_STRUCT_STAT64 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "open64" "ac_cv_func_open64" if test "x$ac_cv_func_open64" = xyes then : printf "%s\n" "#define HAVE_OPEN64 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "lseek64" "ac_cv_func_lseek64" if test "x$ac_cv_func_lseek64" = xyes then : printf "%s\n" "#define HAVE_LSEEK64 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for off64_t" >&5 printf %s "checking for off64_t... " >&6; } if test ${tcl_cv_type_off64_t+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) { off64_t offset; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_type_off64_t=yes else $as_nop tcl_cv_type_off64_t=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then printf "%s\n" "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi #-------------------------------------------------------------------- # Check endianness because we can optimize comparisons of # Tcl_UniChar strings to memcmp on big-endian systems. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 printf %s "checking whether byte ordering is bigendian... " >&6; } if test ${ac_cv_c_bigendian+y} then : printf %s "(cached) " >&6 else $as_nop ac_cv_c_bigendian=unknown # See if we're dealing with a universal compiler. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef __APPLE_CC__ not a universal capable compiler #endif typedef int dummy; _ACEOF if ac_fn_c_try_compile "$LINENO" then : # Check for potential -arch flags. It is not universal unless # there are at least two -arch flags with different values. ac_arch= ac_prev= for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do if test -n "$ac_prev"; then |
︙ | ︙ | |||
7209 7210 7211 7212 7213 7214 7215 | esac ac_prev= elif test "x$ac_word" = "x-arch"; then ac_prev=arch fi done fi | | | | > | | > | | | | | > | | > | | | | > | | | | | | > | | | | > | | | | | > | | < > | < | | < > | > | | < | > | | < | > | | < | > | | < | > | | | > | | | > | | | > | | | > | | > | | | > | | < > | > < | < | | > < | < | | > < | < | | > < | < | | | > | > | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | > | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | > | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | > | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | | | | | > | < | < | > | | > | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | > | < | < | > | | > | | | > | | | | > | | | | | | | | > | | | | > | | | | | | < < | | < > | < < < < < | | < > | < < < < < | | < > | < < < | | | > | | | | > | | | | | | | > | | | > | | | | | | | | | | | | | | | < | < | | | < > | < | | < | | | | | | > | < | > | | | | | | < | | < > | < | < < > | < | < | < < < < > > > | > | > > | | > | > | | > | > | < > | | | | > | < | < | < | < | > | < < < < < < < | > > > > > > > > > | > > | | | > | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | > | | | | | | | | > | | | | > | | | | | | | | > | | | | > | | | | | | > < | < | > < | < | > < | < | > | | | | | > | | | > | | | 7928 7929 7930 7931 7932 7933 7934 7935 7936 7937 7938 7939 7940 7941 7942 7943 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 7974 7975 7976 7977 7978 7979 7980 7981 7982 7983 7984 7985 7986 7987 7988 7989 7990 7991 7992 7993 7994 7995 7996 7997 7998 7999 8000 8001 8002 8003 8004 8005 8006 8007 8008 8009 8010 8011 8012 8013 8014 8015 8016 8017 8018 8019 8020 8021 8022 8023 8024 8025 8026 8027 8028 8029 8030 8031 8032 8033 8034 8035 8036 8037 8038 8039 8040 8041 8042 8043 8044 8045 8046 8047 8048 8049 8050 8051 8052 8053 8054 8055 8056 8057 8058 8059 8060 8061 8062 8063 8064 8065 8066 8067 8068 8069 8070 8071 8072 8073 8074 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 8110 8111 8112 8113 8114 8115 8116 8117 8118 8119 8120 8121 8122 8123 8124 8125 8126 8127 8128 8129 8130 8131 8132 8133 8134 8135 8136 8137 8138 8139 8140 8141 8142 8143 8144 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 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 8189 8190 8191 8192 8193 8194 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 8206 8207 8208 8209 8210 8211 8212 8213 8214 8215 8216 8217 8218 8219 8220 8221 8222 8223 8224 8225 8226 8227 8228 8229 8230 8231 8232 8233 8234 8235 8236 8237 8238 8239 8240 8241 8242 8243 8244 8245 8246 8247 8248 8249 8250 8251 8252 8253 8254 8255 8256 8257 8258 8259 8260 8261 8262 8263 8264 8265 8266 8267 8268 8269 8270 8271 8272 8273 8274 8275 8276 8277 8278 8279 8280 8281 8282 8283 8284 8285 8286 8287 8288 8289 8290 8291 8292 8293 8294 8295 8296 8297 8298 8299 8300 8301 8302 8303 8304 8305 8306 8307 8308 8309 8310 8311 8312 8313 8314 8315 8316 8317 8318 8319 8320 8321 8322 8323 8324 8325 8326 8327 8328 8329 8330 8331 8332 8333 8334 8335 8336 8337 8338 8339 8340 8341 8342 8343 8344 8345 8346 8347 8348 8349 8350 8351 8352 8353 8354 8355 8356 8357 8358 8359 8360 8361 8362 8363 8364 8365 8366 8367 8368 8369 8370 8371 8372 8373 8374 8375 8376 8377 8378 8379 8380 8381 8382 8383 8384 8385 8386 8387 8388 8389 8390 8391 8392 8393 8394 8395 8396 8397 8398 8399 8400 8401 8402 8403 8404 8405 8406 8407 8408 8409 8410 8411 8412 8413 8414 8415 8416 8417 8418 8419 8420 8421 8422 8423 8424 8425 8426 8427 8428 8429 8430 8431 8432 8433 8434 8435 8436 8437 8438 8439 8440 8441 8442 8443 8444 8445 8446 8447 8448 8449 8450 8451 8452 8453 8454 8455 8456 8457 8458 8459 8460 8461 8462 8463 8464 8465 8466 8467 8468 8469 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 8519 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 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 8591 8592 8593 8594 8595 8596 8597 8598 8599 8600 8601 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 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 8693 8694 8695 8696 8697 8698 8699 8700 8701 8702 8703 8704 8705 8706 8707 8708 8709 8710 8711 8712 8713 8714 8715 8716 8717 8718 8719 8720 8721 8722 8723 8724 8725 8726 8727 8728 8729 8730 8731 8732 8733 8734 8735 8736 8737 8738 8739 8740 8741 8742 8743 8744 8745 8746 8747 8748 8749 8750 8751 8752 8753 8754 8755 8756 8757 8758 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770 8771 8772 8773 8774 8775 8776 8777 8778 8779 8780 8781 8782 8783 8784 8785 8786 8787 8788 8789 8790 8791 8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 8816 8817 8818 8819 8820 8821 8822 8823 8824 8825 8826 8827 8828 8829 8830 8831 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 8843 8844 8845 8846 8847 8848 8849 8850 8851 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 8862 8863 8864 8865 8866 8867 8868 8869 8870 8871 8872 8873 8874 8875 8876 8877 8878 8879 8880 8881 8882 8883 8884 8885 8886 8887 8888 8889 8890 8891 8892 8893 8894 8895 8896 8897 8898 8899 8900 8901 8902 8903 8904 8905 8906 8907 8908 8909 8910 8911 8912 8913 8914 8915 8916 8917 8918 8919 8920 8921 8922 8923 8924 8925 8926 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 8937 8938 8939 8940 8941 8942 8943 8944 8945 8946 8947 8948 8949 8950 8951 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 8979 8980 8981 8982 8983 8984 8985 8986 8987 8988 8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 9012 9013 9014 9015 9016 9017 9018 9019 9020 9021 9022 9023 9024 9025 9026 9027 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 9055 9056 9057 9058 9059 9060 9061 9062 9063 9064 9065 9066 9067 9068 9069 9070 9071 9072 9073 9074 9075 9076 9077 9078 9079 9080 9081 9082 9083 9084 9085 9086 9087 9088 9089 9090 9091 9092 9093 9094 9095 9096 9097 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 9378 9379 9380 9381 9382 9383 9384 9385 9386 9387 9388 9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 9399 9400 9401 9402 9403 9404 9405 9406 9407 9408 9409 9410 9411 9412 9413 9414 9415 9416 9417 9418 9419 9420 9421 9422 9423 9424 9425 9426 9427 9428 9429 9430 9431 9432 9433 9434 9435 9436 9437 9438 9439 9440 9441 9442 9443 9444 9445 9446 9447 9448 9449 9450 9451 9452 9453 9454 9455 9456 9457 9458 9459 9460 9461 9462 9463 9464 9465 9466 9467 9468 9469 9470 9471 9472 9473 9474 9475 9476 9477 9478 9479 9480 9481 9482 9483 9484 9485 9486 9487 9488 9489 9490 9491 9492 9493 9494 9495 9496 9497 9498 9499 9500 9501 9502 9503 9504 9505 9506 9507 9508 9509 9510 9511 9512 9513 9514 9515 9516 9517 9518 9519 9520 9521 9522 9523 9524 9525 9526 9527 9528 9529 9530 9531 9532 9533 9534 | esac ac_prev= elif test "x$ac_word" = "x-arch"; then ac_prev=arch fi done fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext if test $ac_cv_c_bigendian = unknown; then # See if sys/param.h defines the BYTE_ORDER macro. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <sys/param.h> int main (void) { #if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ && LITTLE_ENDIAN) bogus endian macros #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : # It does; now see whether it defined to BIG_ENDIAN or not. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <sys/param.h> int main (void) { #if BYTE_ORDER != BIG_ENDIAN not big endian #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_c_bigendian=yes else $as_nop ac_cv_c_bigendian=no 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 fi if test $ac_cv_c_bigendian = unknown; then # See if <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <limits.h> int main (void) { #if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) bogus endian macros #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : # It does; now see whether it defined to _BIG_ENDIAN or not. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <limits.h> int main (void) { #ifndef _BIG_ENDIAN not big endian #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_c_bigendian=yes else $as_nop ac_cv_c_bigendian=no 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 fi if test $ac_cv_c_bigendian = unknown; then # Compile a test program. if test "$cross_compiling" = yes then : # Try to guess by grepping values from an object file. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ unsigned short int ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; unsigned short int ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; int use_ascii (int i) { return ascii_mm[i] + ascii_ii[i]; } unsigned short int ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; unsigned short int ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; int use_ebcdic (int i) { return ebcdic_mm[i] + ebcdic_ii[i]; } extern int foo; int main (void) { return use_ascii (foo) == use_ebcdic (foo); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then ac_cv_c_bigendian=yes fi if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then if test "$ac_cv_c_bigendian" = unknown; then ac_cv_c_bigendian=no else # finding both strings is unlikely to happen, but who knows? ac_cv_c_bigendian=unknown fi fi fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_includes_default int main (void) { /* Are we little or big endian? From Harbison&Steele. */ union { long int l; char c[sizeof (long int)]; } u; u.l = 1; return u.c[sizeof (long int) - 1] == 1; ; return 0; } _ACEOF if ac_fn_c_try_run "$LINENO" then : ac_cv_c_bigendian=no else $as_nop ac_cv_c_bigendian=yes fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ conftest.$ac_objext conftest.beam conftest.$ac_ext fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 printf "%s\n" "$ac_cv_c_bigendian" >&6; } case $ac_cv_c_bigendian in #( yes) printf "%s\n" "#define WORDS_BIGENDIAN 1" >>confdefs.h ;; #( no) ;; #( universal) printf "%s\n" "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h ;; #( *) as_fn_error $? "unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; esac #-------------------------------------------------------------------- # Supply substitutes for missing POSIX library procedures, or # set flags so Tcl uses alternate procedures. #-------------------------------------------------------------------- # Check if Posix compliant getcwd exists, if not we'll use getwd. for ac_func in getcwd do : ac_fn_c_check_func "$LINENO" "getcwd" "ac_cv_func_getcwd" if test "x$ac_cv_func_getcwd" = xyes then : printf "%s\n" "#define HAVE_GETCWD 1" >>confdefs.h else $as_nop printf "%s\n" "#define USEGETWD 1" >>confdefs.h fi done # Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really # define USEGETWD even if the posix getcwd exists. Add a test ? ac_fn_c_check_func "$LINENO" "mkstemp" "ac_cv_func_mkstemp" if test "x$ac_cv_func_mkstemp" = xyes then : printf "%s\n" "#define HAVE_MKSTEMP 1" >>confdefs.h else $as_nop case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac fi ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir" if test "x$ac_cv_func_opendir" = xyes then : printf "%s\n" "#define HAVE_OPENDIR 1" >>confdefs.h else $as_nop case " $LIBOBJS " in *" opendir.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS opendir.$ac_objext" ;; esac fi ac_fn_c_check_func "$LINENO" "strtol" "ac_cv_func_strtol" if test "x$ac_cv_func_strtol" = xyes then : printf "%s\n" "#define HAVE_STRTOL 1" >>confdefs.h else $as_nop case " $LIBOBJS " in *" strtol.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS strtol.$ac_objext" ;; esac fi ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid" if test "x$ac_cv_func_waitpid" = xyes then : printf "%s\n" "#define HAVE_WAITPID 1" >>confdefs.h else $as_nop case " $LIBOBJS " in *" waitpid.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS waitpid.$ac_objext" ;; esac fi ac_fn_c_check_func "$LINENO" "strerror" "ac_cv_func_strerror" if test "x$ac_cv_func_strerror" = xyes then : else $as_nop printf "%s\n" "#define NO_STRERROR 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" if test "x$ac_cv_func_getwd" = xyes then : else $as_nop printf "%s\n" "#define NO_GETWD 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "wait3" "ac_cv_func_wait3" if test "x$ac_cv_func_wait3" = xyes then : else $as_nop printf "%s\n" "#define NO_WAIT3 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname" if test "x$ac_cv_func_uname" = xyes then : else $as_nop printf "%s\n" "#define NO_UNAME 1" >>confdefs.h fi if test "`uname -s`" = "Darwin" && \ test "`uname -r | awk -F. '{print $1}'`" -lt 7; then # prior to Darwin 7, realpath is not threadsafe, so don't # use it when threads are enabled, c.f. bug # 711232 ac_cv_func_realpath=no fi ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath" if test "x$ac_cv_func_realpath" = xyes then : else $as_nop printf "%s\n" "#define NO_REALPATH 1" >>confdefs.h fi NEED_FAKE_RFC2553=0 for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror do : as_ac_var=`printf "%s\n" "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" if eval test \"x\$"$as_ac_var"\" = x"yes" then : cat >>confdefs.h <<_ACEOF #define `printf "%s\n" "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF else $as_nop NEED_FAKE_RFC2553=1 fi done ac_fn_c_check_type "$LINENO" "struct addrinfo" "ac_cv_type_struct_addrinfo" " #include <sys/types.h> #include <sys/socket.h> #include <netinet/in.h> #include <netdb.h> " if test "x$ac_cv_type_struct_addrinfo" = xyes then : printf "%s\n" "#define HAVE_STRUCT_ADDRINFO 1" >>confdefs.h else $as_nop NEED_FAKE_RFC2553=1 fi ac_fn_c_check_type "$LINENO" "struct in6_addr" "ac_cv_type_struct_in6_addr" " #include <sys/types.h> #include <sys/socket.h> #include <netinet/in.h> #include <netdb.h> " if test "x$ac_cv_type_struct_in6_addr" = xyes then : printf "%s\n" "#define HAVE_STRUCT_IN6_ADDR 1" >>confdefs.h else $as_nop NEED_FAKE_RFC2553=1 fi ac_fn_c_check_type "$LINENO" "struct sockaddr_in6" "ac_cv_type_struct_sockaddr_in6" " #include <sys/types.h> #include <sys/socket.h> #include <netinet/in.h> #include <netdb.h> " if test "x$ac_cv_type_struct_sockaddr_in6" = xyes then : printf "%s\n" "#define HAVE_STRUCT_SOCKADDR_IN6 1" >>confdefs.h else $as_nop NEED_FAKE_RFC2553=1 fi ac_fn_c_check_type "$LINENO" "struct sockaddr_storage" "ac_cv_type_struct_sockaddr_storage" " #include <sys/types.h> #include <sys/socket.h> #include <netinet/in.h> #include <netdb.h> " if test "x$ac_cv_type_struct_sockaddr_storage" = xyes then : printf "%s\n" "#define HAVE_STRUCT_SOCKADDR_STORAGE 1" >>confdefs.h else $as_nop NEED_FAKE_RFC2553=1 fi if test "x$NEED_FAKE_RFC2553" = "x1"; then printf "%s\n" "#define NEED_FAKE_RFC2553 1" >>confdefs.h case " $LIBOBJS " in *" fake-rfc2553.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext" ;; esac ac_fn_c_check_func "$LINENO" "strlcpy" "ac_cv_func_strlcpy" if test "x$ac_cv_func_strlcpy" = xyes then : fi fi #-------------------------------------------------------------------- # Look for thread-safe variants of some library functions. #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "getpwuid_r" "ac_cv_func_getpwuid_r" if test "x$ac_cv_func_getpwuid_r" = xyes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 5 args" >&5 printf %s "checking for getpwuid_r with 5 args... " >&6; } if test ${tcl_cv_api_getpwuid_r_5+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <pwd.h> int main (void) { uid_t uid; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getpwuid_r_5=yes else $as_nop tcl_cv_api_getpwuid_r_5=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_api_getpwuid_r_5" >&5 printf "%s\n" "$tcl_cv_api_getpwuid_r_5" >&6; } tcl_ok=$tcl_cv_api_getpwuid_r_5 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETPWUID_R_5 1" >>confdefs.h else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 4 args" >&5 printf %s "checking for getpwuid_r with 4 args... " >&6; } if test ${tcl_cv_api_getpwuid_r_4+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <pwd.h> int main (void) { uid_t uid; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(uid, &pw, buf, buflen); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getpwuid_r_4=yes else $as_nop tcl_cv_api_getpwuid_r_4=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_api_getpwuid_r_4" >&5 printf "%s\n" "$tcl_cv_api_getpwuid_r_4" >&6; } tcl_ok=$tcl_cv_api_getpwuid_r_4 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETPWUID_R_4 1" >>confdefs.h fi fi if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETPWUID_R 1" >>confdefs.h fi fi ac_fn_c_check_func "$LINENO" "getpwnam_r" "ac_cv_func_getpwnam_r" if test "x$ac_cv_func_getpwnam_r" = xyes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 5 args" >&5 printf %s "checking for getpwnam_r with 5 args... " >&6; } if test ${tcl_cv_api_getpwnam_r_5+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <pwd.h> int main (void) { char *name; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwnam_r(name, &pw, buf, buflen, &pwp); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getpwnam_r_5=yes else $as_nop tcl_cv_api_getpwnam_r_5=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_api_getpwnam_r_5" >&5 printf "%s\n" "$tcl_cv_api_getpwnam_r_5" >&6; } tcl_ok=$tcl_cv_api_getpwnam_r_5 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETPWNAM_R_5 1" >>confdefs.h else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 4 args" >&5 printf %s "checking for getpwnam_r with 4 args... " >&6; } if test ${tcl_cv_api_getpwnam_r_4+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <pwd.h> int main (void) { char *name; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(name, &pw, buf, buflen); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getpwnam_r_4=yes else $as_nop tcl_cv_api_getpwnam_r_4=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_api_getpwnam_r_4" >&5 printf "%s\n" "$tcl_cv_api_getpwnam_r_4" >&6; } tcl_ok=$tcl_cv_api_getpwnam_r_4 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETPWNAM_R_4 1" >>confdefs.h fi fi if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETPWNAM_R 1" >>confdefs.h fi fi ac_fn_c_check_func "$LINENO" "getgrgid_r" "ac_cv_func_getgrgid_r" if test "x$ac_cv_func_getgrgid_r" = xyes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 5 args" >&5 printf %s "checking for getgrgid_r with 5 args... " >&6; } if test ${tcl_cv_api_getgrgid_r_5+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <grp.h> int main (void) { gid_t gid; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrgid_r(gid, &gr, buf, buflen, &grp); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getgrgid_r_5=yes else $as_nop tcl_cv_api_getgrgid_r_5=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_api_getgrgid_r_5" >&5 printf "%s\n" "$tcl_cv_api_getgrgid_r_5" >&6; } tcl_ok=$tcl_cv_api_getgrgid_r_5 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETGRGID_R_5 1" >>confdefs.h else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 4 args" >&5 printf %s "checking for getgrgid_r with 4 args... " >&6; } if test ${tcl_cv_api_getgrgid_r_4+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <grp.h> int main (void) { gid_t gid; struct group gr; char buf[512]; int buflen = 512; (void)getgrgid_r(gid, &gr, buf, buflen); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getgrgid_r_4=yes else $as_nop tcl_cv_api_getgrgid_r_4=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_api_getgrgid_r_4" >&5 printf "%s\n" "$tcl_cv_api_getgrgid_r_4" >&6; } tcl_ok=$tcl_cv_api_getgrgid_r_4 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETGRGID_R_4 1" >>confdefs.h fi fi if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETGRGID_R 1" >>confdefs.h fi fi ac_fn_c_check_func "$LINENO" "getgrnam_r" "ac_cv_func_getgrnam_r" if test "x$ac_cv_func_getgrnam_r" = xyes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 5 args" >&5 printf %s "checking for getgrnam_r with 5 args... " >&6; } if test ${tcl_cv_api_getgrnam_r_5+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <grp.h> int main (void) { char *name; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrnam_r(name, &gr, buf, buflen, &grp); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getgrnam_r_5=yes else $as_nop tcl_cv_api_getgrnam_r_5=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_api_getgrnam_r_5" >&5 printf "%s\n" "$tcl_cv_api_getgrnam_r_5" >&6; } tcl_ok=$tcl_cv_api_getgrnam_r_5 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETGRNAM_R_5 1" >>confdefs.h else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 4 args" >&5 printf %s "checking for getgrnam_r with 4 args... " >&6; } if test ${tcl_cv_api_getgrnam_r_4+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <grp.h> int main (void) { char *name; struct group gr; char buf[512]; int buflen = 512; (void)getgrnam_r(name, &gr, buf, buflen); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getgrnam_r_4=yes else $as_nop tcl_cv_api_getgrnam_r_4=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_api_getgrnam_r_4" >&5 printf "%s\n" "$tcl_cv_api_getgrnam_r_4" >&6; } tcl_ok=$tcl_cv_api_getgrnam_r_4 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETGRNAM_R_4 1" >>confdefs.h fi fi if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETGRNAM_R 1" >>confdefs.h fi fi if test "`uname -s`" = "Darwin" && \ test "`uname -r | awk -F. '{print $1}'`" -gt 5; then # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX # are actually MT-safe as they always return pointers # from TSD instead of static storage. printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h elif test "`uname -s`" = "HP-UX" && \ test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then # Starting with HPUX 11.00 (we believe), gethostbyX # are actually MT-safe as they always return pointers # from TSD instead of static storage. printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h else # Avoids picking hidden internal symbol from libc ac_fn_c_check_decl "$LINENO" "gethostbyname_r" "ac_cv_have_decl_gethostbyname_r" "#include <netdb.h> " 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 fi if test "$tcl_cv_api_gethostbyname_r" = yes; then ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r" if test "x$ac_cv_func_gethostbyname_r" = xyes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 6 args" >&5 printf %s "checking for gethostbyname_r with 6 args... " >&6; } if test ${tcl_cv_api_gethostbyname_r_6+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <netdb.h> int main (void) { char *name; struct hostent *he, *res; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyname_r_6=yes else $as_nop tcl_cv_api_gethostbyname_r_6=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_api_gethostbyname_r_6" >&5 printf "%s\n" "$tcl_cv_api_gethostbyname_r_6" >&6; } tcl_ok=$tcl_cv_api_gethostbyname_r_6 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETHOSTBYNAME_R_6 1" >>confdefs.h else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 5 args" >&5 printf %s "checking for gethostbyname_r with 5 args... " >&6; } if test ${tcl_cv_api_gethostbyname_r_5+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <netdb.h> int main (void) { char *name; struct hostent *he; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyname_r_5=yes else $as_nop tcl_cv_api_gethostbyname_r_5=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_api_gethostbyname_r_5" >&5 printf "%s\n" "$tcl_cv_api_gethostbyname_r_5" >&6; } tcl_ok=$tcl_cv_api_gethostbyname_r_5 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETHOSTBYNAME_R_5 1" >>confdefs.h else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 3 args" >&5 printf %s "checking for gethostbyname_r with 3 args... " >&6; } if test ${tcl_cv_api_gethostbyname_r_3+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <netdb.h> int main (void) { char *name; struct hostent *he; struct hostent_data data; (void) gethostbyname_r(name, he, &data); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyname_r_3=yes else $as_nop tcl_cv_api_gethostbyname_r_3=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_api_gethostbyname_r_3" >&5 printf "%s\n" "$tcl_cv_api_gethostbyname_r_3" >&6; } tcl_ok=$tcl_cv_api_gethostbyname_r_3 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETHOSTBYNAME_R_3 1" >>confdefs.h fi fi fi if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETHOSTBYNAME_R 1" >>confdefs.h fi fi fi # Avoids picking hidden internal symbol from libc ac_fn_c_check_decl "$LINENO" "gethostbyaddr_r" "ac_cv_have_decl_gethostbyaddr_r" "#include <netdb.h> " 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 fi if test "$tcl_cv_api_gethostbyaddr_r" = yes; then ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r" if test "x$ac_cv_func_gethostbyaddr_r" = xyes then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 7 args" >&5 printf %s "checking for gethostbyaddr_r with 7 args... " >&6; } if test ${tcl_cv_api_gethostbyaddr_r_7+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <netdb.h> int main (void) { char *addr; int length; int type; struct hostent *result; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &h_errnop); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyaddr_r_7=yes else $as_nop tcl_cv_api_gethostbyaddr_r_7=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_api_gethostbyaddr_r_7" >&5 printf "%s\n" "$tcl_cv_api_gethostbyaddr_r_7" >&6; } tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETHOSTBYADDR_R_7 1" >>confdefs.h else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 8 args" >&5 printf %s "checking for gethostbyaddr_r with 8 args... " >&6; } if test ${tcl_cv_api_gethostbyaddr_r_8+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <netdb.h> int main (void) { char *addr; int length; int type; struct hostent *result, *resultp; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &resultp, &h_errnop); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyaddr_r_8=yes else $as_nop tcl_cv_api_gethostbyaddr_r_8=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_api_gethostbyaddr_r_8" >&5 printf "%s\n" "$tcl_cv_api_gethostbyaddr_r_8" >&6; } tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETHOSTBYADDR_R_8 1" >>confdefs.h fi fi if test "$tcl_ok" = yes; then printf "%s\n" "#define HAVE_GETHOSTBYADDR_R 1" >>confdefs.h fi fi fi fi #--------------------------------------------------------------------------- # Check for serial port interface. # # termios.h is present on all POSIX systems. # sys/ioctl.h is almost always present, though what it contains # is system-specific. # sys/modem.h is needed on HP-UX. #--------------------------------------------------------------------------- ac_fn_c_check_header_compile "$LINENO" "termios.h" "ac_cv_header_termios_h" "$ac_includes_default" if test "x$ac_cv_header_termios_h" = xyes then : printf "%s\n" "#define HAVE_TERMIOS_H 1" >>confdefs.h fi ac_fn_c_check_header_compile "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default" if test "x$ac_cv_header_sys_ioctl_h" = xyes then : printf "%s\n" "#define HAVE_SYS_IOCTL_H 1" >>confdefs.h fi ac_fn_c_check_header_compile "$LINENO" "sys/modem.h" "ac_cv_header_sys_modem_h" "$ac_includes_default" if test "x$ac_cv_header_sys_modem_h" = xyes then : printf "%s\n" "#define HAVE_SYS_MODEM_H 1" >>confdefs.h fi #-------------------------------------------------------------------- # Include sys/select.h if it exists and if it supplies things # that appear to be useful and aren't already in sys/types.h. # This appears to be true only on the RS/6000 under AIX. Some # systems like OSF/1 have a sys/select.h that's of no use, and # other systems like SCO UNIX have a sys/select.h that's # pernicious. If "fd_set" isn't defined anywhere then set a # special flag. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for fd_set in sys/types" >&5 printf %s "checking for fd_set in sys/types... " >&6; } if test ${tcl_cv_type_fd_set+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) { fd_set readMask, writeMask; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_type_fd_set=yes else $as_nop tcl_cv_type_fd_set=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_type_fd_set" >&5 printf "%s\n" "$tcl_cv_type_fd_set" >&6; } tcl_ok=$tcl_cv_type_fd_set if test $tcl_ok = no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for fd_mask in sys/select" >&5 printf %s "checking for fd_mask in sys/select... " >&6; } if test ${tcl_cv_grep_fd_mask+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/select.h> _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "fd_mask" >/dev/null 2>&1 then : tcl_cv_grep_fd_mask=present else $as_nop tcl_cv_grep_fd_mask=missing fi rm -rf conftest* fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_fd_mask" >&5 printf "%s\n" "$tcl_cv_grep_fd_mask" >&6; } if test $tcl_cv_grep_fd_mask = present; then printf "%s\n" "#define HAVE_SYS_SELECT_H 1" >>confdefs.h tcl_ok=yes 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 printf %s "checking for advanced notifier support... " >&6; } case x`uname -s` in xLinux) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: epoll(7)" >&5 printf "%s\n" "epoll(7)" >&6; } for ac_header in sys/epoll.h do : ac_fn_c_check_header_compile "$LINENO" "sys/epoll.h" "ac_cv_header_sys_epoll_h" "$ac_includes_default" if test "x$ac_cv_header_sys_epoll_h" = xyes then : printf "%s\n" "#define HAVE_SYS_EPOLL_H 1" >>confdefs.h printf "%s\n" "#define NOTIFIER_EPOLL 1" >>confdefs.h fi done for ac_header in sys/eventfd.h do : ac_fn_c_check_header_compile "$LINENO" "sys/eventfd.h" "ac_cv_header_sys_eventfd_h" "$ac_includes_default" if test "x$ac_cv_header_sys_eventfd_h" = xyes then : printf "%s\n" "#define HAVE_SYS_EVENTFD_H 1" >>confdefs.h printf "%s\n" "#define HAVE_EVENTFD 1" >>confdefs.h fi done;; xDragonFlyBSD|xFreeBSD|xNetBSD|xOpenBSD) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: kqueue(2)" >&5 printf "%s\n" "kqueue(2)" >&6; } # Messy because we want to check if *all* the headers are present, and not # just *any* tcl_kqueue_headers=x for ac_header in sys/types.h sys/event.h sys/time.h do : as_ac_Header=`printf "%s\n" "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" if eval test \"x\$"$as_ac_Header"\" = x"yes" then : cat >>confdefs.h <<_ACEOF #define `printf "%s\n" "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF tcl_kqueue_headers=${tcl_kqueue_headers}y fi done if test $tcl_kqueue_headers = xyyy then : printf "%s\n" "#define NOTIFIER_KQUEUE 1" >>confdefs.h fi;; xDarwin) # Assume that we've got CoreFoundation present (checked elsewhere because # of wider impact). { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: OSX" >&5 printf "%s\n" "OSX" >&6; };; *) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none" >&5 printf "%s\n" "none" >&6; };; esac #------------------------------------------------------------------------------ # Find out all about time handling differences. #------------------------------------------------------------------------------ ac_fn_c_check_header_compile "$LINENO" "sys/time.h" "ac_cv_header_sys_time_h" "$ac_includes_default" if test "x$ac_cv_header_sys_time_h" = xyes then : printf "%s\n" "#define HAVE_SYS_TIME_H 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "gmtime_r" "ac_cv_func_gmtime_r" if test "x$ac_cv_func_gmtime_r" = xyes then : printf "%s\n" "#define HAVE_GMTIME_R 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "localtime_r" "ac_cv_func_localtime_r" if test "x$ac_cv_func_localtime_r" = xyes then : printf "%s\n" "#define HAVE_LOCALTIME_R 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "mktime" "ac_cv_func_mktime" if test "x$ac_cv_func_mktime" = xyes then : printf "%s\n" "#define HAVE_MKTIME 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking tm_tzadj in struct tm" >&5 printf %s "checking tm_tzadj in struct tm... " >&6; } if test ${tcl_cv_member_tm_tzadj+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <time.h> int main (void) { struct tm tm; (void)tm.tm_tzadj; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_member_tm_tzadj=yes else $as_nop tcl_cv_member_tm_tzadj=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_member_tm_tzadj" >&5 printf "%s\n" "$tcl_cv_member_tm_tzadj" >&6; } if test $tcl_cv_member_tm_tzadj = yes ; then printf "%s\n" "#define HAVE_TM_TZADJ 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking tm_gmtoff in struct tm" >&5 printf %s "checking tm_gmtoff in struct tm... " >&6; } if test ${tcl_cv_member_tm_gmtoff+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <time.h> int main (void) { struct tm tm; (void)tm.tm_gmtoff; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_member_tm_gmtoff=yes else $as_nop tcl_cv_member_tm_gmtoff=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_member_tm_gmtoff" >&5 printf "%s\n" "$tcl_cv_member_tm_gmtoff" >&6; } if test $tcl_cv_member_tm_gmtoff = yes ; then printf "%s\n" "#define HAVE_TM_GMTOFF 1" >>confdefs.h fi # # Its important to include time.h in this check, as some systems # (like convex) have timezone functions, etc. # { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking long timezone variable" >&5 printf %s "checking long timezone variable... " >&6; } if test ${tcl_cv_timezone_long+y} 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); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_timezone_long=yes else $as_nop tcl_cv_timezone_long=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_timezone_long" >&5 printf "%s\n" "$tcl_cv_timezone_long" >&6; } if test $tcl_cv_timezone_long = yes ; then printf "%s\n" "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h else # # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. # { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking time_t timezone variable" >&5 printf %s "checking time_t timezone variable... " >&6; } if test ${tcl_cv_timezone_time+y} 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); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_timezone_time=yes else $as_nop tcl_cv_timezone_time=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_timezone_time" >&5 printf "%s\n" "$tcl_cv_timezone_time" >&6; } if test $tcl_cv_timezone_time = yes ; then printf "%s\n" "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h fi fi #-------------------------------------------------------------------- # Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But # we might be able to use fstatfs instead. Some systems (OpenBSD?) also # lack blkcnt_t. #-------------------------------------------------------------------- if test "$ac_cv_cygwin" != "yes"; then ac_fn_c_check_member "$LINENO" "struct stat" "st_blocks" "ac_cv_member_struct_stat_st_blocks" "$ac_includes_default" if test "x$ac_cv_member_struct_stat_st_blocks" = xyes then : printf "%s\n" "#define HAVE_STRUCT_STAT_ST_BLOCKS 1" >>confdefs.h fi ac_fn_c_check_member "$LINENO" "struct stat" "st_blksize" "ac_cv_member_struct_stat_st_blksize" "$ac_includes_default" if test "x$ac_cv_member_struct_stat_st_blksize" = xyes then : printf "%s\n" "#define HAVE_STRUCT_STAT_ST_BLKSIZE 1" >>confdefs.h fi fi ac_fn_c_check_type "$LINENO" "blkcnt_t" "ac_cv_type_blkcnt_t" "$ac_includes_default" if test "x$ac_cv_type_blkcnt_t" = xyes then : printf "%s\n" "#define HAVE_BLKCNT_T 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "fstatfs" "ac_cv_func_fstatfs" if test "x$ac_cv_func_fstatfs" = xyes then : else $as_nop printf "%s\n" "#define NO_FSTATFS 1" >>confdefs.h fi #-------------------------------------------------------------------- # Some system have no memcmp or it does not work with 8 bit data, this # checks it and add memcmp.o to LIBOBJS if needed #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working memcmp" >&5 printf %s "checking for working memcmp... " >&6; } if test ${ac_cv_func_memcmp_working+y} then : printf %s "(cached) " >&6 else $as_nop if test "$cross_compiling" = yes then : ac_cv_func_memcmp_working=no else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_includes_default int main (void) { /* Some versions of memcmp are not 8-bit clean. */ char c0 = '\100', c1 = '\200', c2 = '\201'; if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0) return 1; |
︙ | ︙ | |||
8826 8827 8828 8829 8830 8831 8832 | return 0; } ; return 0; } _ACEOF | | > | | | | > | | | | > | | | | > | | | > | | > | | | | 9551 9552 9553 9554 9555 9556 9557 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 9568 9569 9570 9571 9572 9573 9574 9575 9576 9577 9578 9579 9580 9581 9582 9583 9584 9585 9586 9587 9588 9589 9590 9591 9592 9593 9594 9595 9596 9597 9598 9599 9600 9601 9602 9603 9604 9605 9606 9607 9608 9609 9610 9611 9612 9613 9614 9615 9616 9617 9618 9619 9620 9621 9622 9623 9624 9625 9626 9627 9628 9629 9630 9631 9632 9633 9634 9635 9636 9637 9638 9639 9640 9641 9642 9643 9644 9645 9646 9647 9648 9649 9650 9651 9652 9653 | return 0; } ; return 0; } _ACEOF if ac_fn_c_try_run "$LINENO" then : ac_cv_func_memcmp_working=yes else $as_nop ac_cv_func_memcmp_working=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ conftest.$ac_objext conftest.beam conftest.$ac_ext fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_memcmp_working" >&5 printf "%s\n" "$ac_cv_func_memcmp_working" >&6; } test $ac_cv_func_memcmp_working = no && case " $LIBOBJS " in *" memcmp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" ;; esac #-------------------------------------------------------------------- # Some system like SunOS 4 and other BSD like systems have no memmove # (we assume they have bcopy instead). {The replacement define is in # compat/string.h} #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "memmove" "ac_cv_func_memmove" if test "x$ac_cv_func_memmove" = xyes then : else $as_nop printf "%s\n" "#define NO_MEMMOVE 1" >>confdefs.h printf "%s\n" "#define NO_STRING_H 1" >>confdefs.h fi #-------------------------------------------------------------------- # On some systems strstr is broken: it returns a pointer even even if # the original string is empty. #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "strstr" "ac_cv_func_strstr" if test "x$ac_cv_func_strstr" = xyes then : tcl_ok=1 else $as_nop tcl_ok=0 fi if test "$tcl_ok" = 1; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking proper strstr implementation" >&5 printf %s "checking proper strstr implementation... " >&6; } if test ${tcl_cv_strstr_unbroken+y} then : printf %s "(cached) " >&6 else $as_nop if test "$cross_compiling" = yes then : tcl_cv_strstr_unbroken=unknown else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <stdlib.h> #include <string.h> int main() { exit(strstr("\0test", "test") ? 1 : 0); } _ACEOF if ac_fn_c_try_run "$LINENO" then : tcl_cv_strstr_unbroken=ok else $as_nop tcl_cv_strstr_unbroken=broken fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ conftest.$ac_objext conftest.beam conftest.$ac_ext fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strstr_unbroken" >&5 printf "%s\n" "$tcl_cv_strstr_unbroken" >&6; } if test "$tcl_cv_strstr_unbroken" = "ok"; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then |
︙ | ︙ | |||
8934 8935 8936 8937 8938 8939 8940 | # Check for strtoul function. This is tricky because under some # versions of AIX strtoul returns an incorrect terminator # pointer for the string "0". #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "strtoul" "ac_cv_func_strtoul" | | > | | | | > | | | > | | > | | | | 9665 9666 9667 9668 9669 9670 9671 9672 9673 9674 9675 9676 9677 9678 9679 9680 9681 9682 9683 9684 9685 9686 9687 9688 9689 9690 9691 9692 9693 9694 9695 9696 9697 9698 9699 9700 9701 9702 9703 9704 9705 9706 9707 9708 9709 9710 9711 9712 9713 9714 9715 9716 9717 9718 9719 | # Check for strtoul function. This is tricky because under some # versions of AIX strtoul returns an incorrect terminator # pointer for the string "0". #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "strtoul" "ac_cv_func_strtoul" if test "x$ac_cv_func_strtoul" = xyes then : tcl_ok=1 else $as_nop tcl_ok=0 fi if test "$tcl_ok" = 1; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking proper strtoul implementation" >&5 printf %s "checking proper strtoul implementation... " >&6; } if test ${tcl_cv_strtoul_unbroken+y} then : printf %s "(cached) " >&6 else $as_nop if test "$cross_compiling" = yes then : tcl_cv_strtoul_unbroken=unknown else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <stdlib.h> #include <string.h> int main() { char *term, *string = "0"; exit(strtoul(string,&term,0) != 0 || term != string+1); } _ACEOF if ac_fn_c_try_run "$LINENO" then : tcl_cv_strtoul_unbroken=ok else $as_nop tcl_cv_strtoul_unbroken=broken fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ conftest.$ac_objext conftest.beam conftest.$ac_ext fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtoul_unbroken" >&5 printf "%s\n" "$tcl_cv_strtoul_unbroken" >&6; } if test "$tcl_cv_strtoul_unbroken" = "ok"; then tcl_ok=1 else tcl_ok=0 fi fi if test "$tcl_ok" = 0; then |
︙ | ︙ | |||
8994 8995 8996 8997 8998 8999 9000 | #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. #-------------------------------------------------------------------- ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" | | > | < | < > | > | > | > > > > > | > > > | > > > > > > > > > > > > > > > | > | < | < | | | > | | | > | | | | | | | | | > | | | | > | | | | | | < | < | < | < < < < < | < < < < < < < | < < < < < < < < < < < < < < < < < < < < < | < < < < < > | < | < | < | < < < < < | < < < < < < < < | < < < | | < < < < < < < < < < < < < < < < < < < < < | > | | | | | > | | | | > | | | | | | > | | | | > | | < < < | | > | | | | | > | | | | > | | < < < | | > | | | | | > | | 9729 9730 9731 9732 9733 9734 9735 9736 9737 9738 9739 9740 9741 9742 9743 9744 9745 9746 9747 9748 9749 9750 9751 9752 9753 9754 9755 9756 9757 9758 9759 9760 9761 9762 9763 9764 9765 9766 9767 9768 9769 9770 9771 9772 9773 9774 9775 9776 9777 9778 9779 9780 9781 9782 9783 9784 9785 9786 9787 9788 9789 9790 9791 9792 9793 9794 9795 9796 9797 9798 9799 9800 9801 9802 9803 9804 9805 9806 9807 9808 9809 9810 9811 9812 9813 9814 9815 9816 9817 9818 9819 9820 9821 9822 9823 9824 9825 9826 9827 9828 9829 9830 9831 9832 9833 9834 9835 9836 9837 9838 9839 9840 9841 9842 9843 9844 9845 9846 9847 9848 9849 9850 9851 9852 9853 9854 9855 9856 9857 9858 9859 9860 9861 9862 9863 9864 9865 9866 9867 9868 9869 9870 9871 9872 9873 9874 9875 9876 9877 9878 9879 9880 9881 9882 9883 9884 9885 9886 9887 9888 9889 9890 9891 9892 9893 9894 9895 9896 9897 9898 9899 9900 9901 9902 9903 9904 9905 9906 9907 9908 9909 9910 9911 9912 9913 9914 9915 9916 9917 9918 9919 9920 9921 9922 9923 9924 9925 9926 9927 9928 9929 9930 9931 9932 9933 9934 9935 9936 9937 9938 9939 9940 9941 9942 9943 9944 9945 9946 9947 9948 9949 9950 9951 9952 9953 9954 9955 9956 9957 9958 9959 9960 9961 9962 9963 9964 9965 9966 9967 9968 9969 9970 9971 9972 9973 9974 9975 9976 9977 9978 9979 9980 9981 9982 9983 9984 9985 9986 9987 9988 9989 9990 9991 9992 9993 9994 9995 9996 9997 9998 9999 10000 10001 10002 10003 10004 10005 10006 10007 10008 10009 10010 10011 10012 10013 10014 10015 10016 10017 10018 10019 10020 10021 10022 10023 10024 10025 10026 10027 10028 10029 10030 10031 10032 10033 10034 10035 10036 10037 10038 10039 10040 10041 10042 10043 10044 10045 10046 10047 10048 10049 10050 10051 10052 10053 10054 10055 10056 10057 10058 | #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. #-------------------------------------------------------------------- ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" if test "x$ac_cv_type_mode_t" = xyes then : else $as_nop printf "%s\n" "#define mode_t int" >>confdefs.h fi ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default " if test "x$ac_cv_type_pid_t" = xyes then : else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #if defined _WIN64 && !defined __CYGWIN__ LLP64 #endif int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_pid_type='int' else $as_nop ac_pid_type='__int64' fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext printf "%s\n" "#define pid_t $ac_pid_type" >>confdefs.h fi ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" if test "x$ac_cv_type_size_t" = xyes then : else $as_nop printf "%s\n" "#define size_t unsigned int" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for uid_t in sys/types.h" >&5 printf %s "checking for uid_t in sys/types.h... " >&6; } if test ${ac_cv_type_uid_t+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "uid_t" >/dev/null 2>&1 then : ac_cv_type_uid_t=yes else $as_nop ac_cv_type_uid_t=no fi rm -rf conftest* fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_uid_t" >&5 printf "%s\n" "$ac_cv_type_uid_t" >&6; } if test $ac_cv_type_uid_t = no; then printf "%s\n" "#define uid_t int" >>confdefs.h printf "%s\n" "#define gid_t int" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for socklen_t" >&5 printf %s "checking for socklen_t... " >&6; } if test ${tcl_cv_type_socklen_t+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <sys/socket.h> int main (void) { socklen_t foo; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_type_socklen_t=yes else $as_nop tcl_cv_type_socklen_t=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_type_socklen_t" >&5 printf "%s\n" "$tcl_cv_type_socklen_t" >&6; } if test $tcl_cv_type_socklen_t = no; then printf "%s\n" "#define socklen_t int" >>confdefs.h fi ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" " #include <stdint.h> " if test "x$ac_cv_type_intptr_t" = xyes then : printf "%s\n" "#define HAVE_INTPTR_T 1" >>confdefs.h fi ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" " #include <stdint.h> " if test "x$ac_cv_type_uintptr_t" = xyes then : printf "%s\n" "#define HAVE_UINTPTR_T 1" >>confdefs.h fi #-------------------------------------------------------------------- # If a system doesn't have an opendir function (man, that's old!) # then we have to supply a different version of dirent.h which # is compatible with the substitute version of opendir that's # provided. This version only works with V7-style directories. #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir" if test "x$ac_cv_func_opendir" = xyes then : else $as_nop printf "%s\n" "#define USE_DIRENT2_H 1" >>confdefs.h fi #-------------------------------------------------------------------- # The check below checks whether <sys/wait.h> defines the type # "union wait" correctly. It's needed because of weirdness in # HP-UX where "union wait" is defined in both the BSD and SYS-V # environments. Checking the usability of WIFEXITED seems to do # the trick. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking union wait" >&5 printf %s "checking union wait... " >&6; } if test ${tcl_cv_union_wait+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> #include <sys/wait.h> int main (void) { union wait x; WIFEXITED(x); /* Generates compiler error if WIFEXITED * uses an int. */ ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_union_wait=yes else $as_nop tcl_cv_union_wait=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_union_wait" >&5 printf "%s\n" "$tcl_cv_union_wait" >&6; } if test $tcl_cv_union_wait = no; then printf "%s\n" "#define NO_UNION_WAIT 1" >>confdefs.h fi #-------------------------------------------------------------------- # Check whether there is an strncasecmp function on this system. # This is a bit tricky because under SCO it's in -lsocket and # under Sequent Dynix it's in -linet. #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "strncasecmp" "ac_cv_func_strncasecmp" if test "x$ac_cv_func_strncasecmp" = xyes then : tcl_ok=1 else $as_nop tcl_ok=0 fi if test "$tcl_ok" = 0; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -lsocket" >&5 printf %s "checking for strncasecmp in -lsocket... " >&6; } if test ${ac_cv_lib_socket_strncasecmp+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char strncasecmp (); int main (void) { return strncasecmp (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_socket_strncasecmp=yes else $as_nop ac_cv_lib_socket_strncasecmp=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_strncasecmp" >&5 printf "%s\n" "$ac_cv_lib_socket_strncasecmp" >&6; } if test "x$ac_cv_lib_socket_strncasecmp" = xyes then : tcl_ok=1 else $as_nop tcl_ok=0 fi fi if test "$tcl_ok" = 0; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -linet" >&5 printf %s "checking for strncasecmp in -linet... " >&6; } if test ${ac_cv_lib_inet_strncasecmp+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char strncasecmp (); int main (void) { return strncasecmp (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_inet_strncasecmp=yes else $as_nop ac_cv_lib_inet_strncasecmp=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_strncasecmp" >&5 printf "%s\n" "$ac_cv_lib_inet_strncasecmp" >&6; } if test "x$ac_cv_lib_inet_strncasecmp" = xyes then : tcl_ok=1 else $as_nop tcl_ok=0 fi fi if test "$tcl_ok" = 0; then case " $LIBOBJS " in *" strncasecmp.$ac_objext "* ) ;; |
︙ | ︙ | |||
9382 9383 9384 9385 9386 9387 9388 | # (set NO_GETTOD if this is the case). # 2. See if gettimeofday is declared in the <sys/time.h> header file. # if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can # declare it. #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" | | > | | | | | > | | | > | | | | | | | | > | | | | > | | | | | | | | | > | | | | > | | | | | | | | > | | | > | | 10069 10070 10071 10072 10073 10074 10075 10076 10077 10078 10079 10080 10081 10082 10083 10084 10085 10086 10087 10088 10089 10090 10091 10092 10093 10094 10095 10096 10097 10098 10099 10100 10101 10102 10103 10104 10105 10106 10107 10108 10109 10110 10111 10112 10113 10114 10115 10116 10117 10118 10119 10120 10121 10122 10123 10124 10125 10126 10127 10128 10129 10130 10131 10132 10133 10134 10135 10136 10137 10138 10139 10140 10141 10142 10143 10144 10145 10146 10147 10148 10149 10150 10151 10152 10153 10154 10155 10156 10157 10158 10159 10160 10161 10162 10163 10164 10165 10166 10167 10168 10169 10170 10171 10172 10173 10174 10175 10176 10177 10178 10179 10180 10181 10182 10183 10184 10185 10186 10187 10188 10189 10190 10191 10192 10193 10194 10195 10196 10197 10198 10199 10200 10201 10202 10203 10204 10205 10206 10207 10208 10209 10210 10211 10212 10213 10214 10215 10216 | # (set NO_GETTOD if this is the case). # 2. See if gettimeofday is declared in the <sys/time.h> header file. # if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can # declare it. #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" if test "x$ac_cv_func_gettimeofday" = xyes then : else $as_nop printf "%s\n" "#define NO_GETTOD 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gettimeofday declaration" >&5 printf %s "checking for gettimeofday declaration... " >&6; } if test ${tcl_cv_grep_gettimeofday+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/time.h> _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "gettimeofday" >/dev/null 2>&1 then : tcl_cv_grep_gettimeofday=present else $as_nop tcl_cv_grep_gettimeofday=missing fi rm -rf conftest* fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_gettimeofday" >&5 printf "%s\n" "$tcl_cv_grep_gettimeofday" >&6; } if test $tcl_cv_grep_gettimeofday = missing ; then printf "%s\n" "#define GETTOD_NOT_DECLARED 1" >>confdefs.h fi #-------------------------------------------------------------------- # The following code checks to see whether it is possible to get # signed chars on this platform. This is needed in order to # properly generate sign-extended ints from character values. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether char is unsigned" >&5 printf %s "checking whether char is unsigned... " >&6; } if test ${ac_cv_c_char_unsigned+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_includes_default int main (void) { static int test_array [1 - 2 * !(((char) -1) < 0)]; test_array [0] = 0; return test_array [0]; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_c_char_unsigned=no else $as_nop ac_cv_c_char_unsigned=yes 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_c_char_unsigned" >&5 printf "%s\n" "$ac_cv_c_char_unsigned" >&6; } if test $ac_cv_c_char_unsigned = yes; then printf "%s\n" "#define __CHAR_UNSIGNED__ 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking signed char declarations" >&5 printf %s "checking signed char declarations... " >&6; } if test ${tcl_cv_char_signed+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { signed char *p; p = 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_char_signed=yes else $as_nop tcl_cv_char_signed=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_char_signed" >&5 printf "%s\n" "$tcl_cv_char_signed" >&6; } if test $tcl_cv_char_signed = yes; then printf "%s\n" "#define HAVE_SIGNED_CHAR 1" >>confdefs.h fi #-------------------------------------------------------------------- # Does putenv() copy or not? We need to know to avoid memory leaks. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for a putenv() that copies the buffer" >&5 printf %s "checking for a putenv() that copies the buffer... " >&6; } if test ${tcl_cv_putenv_copy+y} then : printf %s "(cached) " >&6 else $as_nop if test "$cross_compiling" = yes then : tcl_cv_putenv_copy=no else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <stdlib.h> #include <string.h> #define OURVAR "havecopy=yes" int main (int argc, char *argv[]) |
︙ | ︙ | |||
9530 9531 9532 9533 9534 9535 9536 | } else { /* does copy */ return 1; } } _ACEOF | | > | | | | | > | | | > | < | | | > | | | | > | | | | | | | > | | > | > | > | | < < > > > > | > | | | > | | | | > | | | | | < < | | < > | < < < < | | < > | < < < < < | | < > | < < < < | | < > | < < < < < | | < > | < | > < < | | | < < | | < > | < < < | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | | > | | | | > | | | | | < < | | < > | < < < < < | | < > | < < < | | | > | | | | | | | | | | | | | | | | > | | | | | | | > | | | | > | | | | | | | > | | | > | < | | | > | | > | > > > | | | | | | | | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | > | | | | > | | | | | | 10226 10227 10228 10229 10230 10231 10232 10233 10234 10235 10236 10237 10238 10239 10240 10241 10242 10243 10244 10245 10246 10247 10248 10249 10250 10251 10252 10253 10254 10255 10256 10257 10258 10259 10260 10261 10262 10263 10264 10265 10266 10267 10268 10269 10270 10271 10272 10273 10274 10275 10276 10277 10278 10279 10280 10281 10282 10283 10284 10285 10286 10287 10288 10289 10290 10291 10292 10293 10294 10295 10296 10297 10298 10299 10300 10301 10302 10303 10304 10305 10306 10307 10308 10309 10310 10311 10312 10313 10314 10315 10316 10317 10318 10319 10320 10321 10322 10323 10324 10325 10326 10327 10328 10329 10330 10331 10332 10333 10334 10335 10336 10337 10338 10339 10340 10341 10342 10343 10344 10345 10346 10347 10348 10349 10350 10351 10352 10353 10354 10355 10356 10357 10358 10359 10360 10361 10362 10363 10364 10365 10366 10367 10368 10369 10370 10371 10372 10373 10374 10375 10376 10377 10378 10379 10380 10381 10382 10383 10384 10385 10386 10387 10388 10389 10390 10391 10392 10393 10394 10395 10396 10397 10398 10399 10400 10401 10402 10403 10404 10405 10406 10407 10408 10409 10410 10411 10412 10413 10414 10415 10416 10417 10418 10419 10420 10421 10422 10423 10424 10425 10426 10427 10428 10429 10430 10431 10432 10433 10434 10435 10436 10437 10438 10439 10440 10441 10442 10443 10444 10445 10446 10447 10448 10449 10450 10451 10452 10453 10454 10455 10456 10457 10458 10459 10460 10461 10462 10463 10464 10465 10466 10467 10468 10469 10470 10471 10472 10473 10474 10475 10476 10477 10478 10479 10480 10481 10482 10483 10484 10485 10486 10487 10488 10489 10490 10491 10492 10493 10494 10495 10496 10497 10498 10499 10500 10501 10502 10503 10504 10505 10506 10507 10508 10509 10510 10511 10512 10513 10514 10515 10516 10517 10518 10519 10520 10521 10522 10523 10524 10525 10526 10527 10528 10529 10530 10531 10532 10533 10534 10535 10536 10537 10538 10539 10540 10541 10542 10543 10544 10545 10546 10547 10548 10549 10550 10551 10552 10553 10554 10555 10556 10557 10558 10559 10560 10561 10562 10563 10564 10565 10566 10567 10568 10569 10570 10571 10572 10573 10574 10575 10576 10577 10578 10579 10580 10581 10582 10583 10584 10585 10586 10587 10588 10589 10590 10591 10592 10593 10594 10595 10596 10597 10598 10599 10600 10601 10602 10603 10604 10605 10606 10607 10608 10609 10610 10611 10612 10613 10614 10615 10616 10617 10618 10619 10620 10621 10622 10623 10624 10625 10626 10627 10628 10629 10630 10631 10632 10633 10634 10635 10636 10637 10638 10639 10640 10641 10642 10643 10644 10645 10646 10647 10648 10649 10650 10651 10652 10653 10654 10655 10656 10657 10658 10659 10660 10661 10662 10663 10664 10665 10666 10667 10668 10669 10670 10671 10672 10673 10674 10675 10676 10677 10678 10679 10680 10681 10682 10683 10684 10685 10686 10687 10688 10689 10690 10691 10692 10693 10694 10695 10696 10697 10698 10699 10700 10701 10702 10703 10704 10705 10706 10707 10708 10709 10710 10711 10712 10713 10714 10715 10716 10717 10718 10719 10720 10721 10722 10723 10724 10725 10726 10727 10728 10729 10730 10731 10732 10733 10734 10735 10736 10737 10738 10739 10740 10741 10742 10743 10744 10745 10746 10747 10748 10749 10750 10751 10752 10753 10754 10755 10756 10757 10758 10759 10760 10761 10762 10763 10764 10765 10766 10767 10768 10769 10770 10771 10772 10773 10774 10775 10776 10777 10778 10779 10780 10781 10782 10783 10784 10785 10786 10787 10788 10789 10790 10791 10792 10793 10794 10795 10796 10797 10798 10799 10800 10801 10802 10803 10804 10805 10806 10807 10808 10809 10810 10811 10812 10813 10814 10815 10816 10817 10818 10819 10820 10821 10822 10823 10824 10825 10826 10827 10828 10829 10830 10831 10832 10833 10834 10835 10836 10837 10838 10839 10840 10841 10842 10843 10844 10845 10846 10847 10848 10849 10850 10851 10852 10853 10854 10855 10856 10857 10858 10859 10860 10861 10862 10863 10864 10865 10866 10867 10868 10869 10870 10871 10872 10873 10874 10875 10876 10877 10878 10879 10880 10881 10882 10883 10884 10885 10886 10887 10888 10889 10890 | } else { /* does copy */ return 1; } } _ACEOF if ac_fn_c_try_run "$LINENO" then : tcl_cv_putenv_copy=no else $as_nop tcl_cv_putenv_copy=yes fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ conftest.$ac_objext conftest.beam conftest.$ac_ext fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_putenv_copy" >&5 printf "%s\n" "$tcl_cv_putenv_copy" >&6; } if test $tcl_cv_putenv_copy = yes; then printf "%s\n" "#define HAVE_PUTENV_THAT_COPIES 1" >>confdefs.h fi #-------------------------------------------------------------------- # Check for support of nl_langinfo function #-------------------------------------------------------------------- # Check whether --enable-langinfo was given. if test ${enable_langinfo+y} then : enableval=$enable_langinfo; langinfo_ok=$enableval else $as_nop langinfo_ok=yes fi HAVE_LANGINFO=0 if test "$langinfo_ok" = "yes"; then ac_fn_c_check_header_compile "$LINENO" "langinfo.h" "ac_cv_header_langinfo_h" "$ac_includes_default" if test "x$ac_cv_header_langinfo_h" = xyes then : langinfo_ok=yes else $as_nop langinfo_ok=no fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use nl_langinfo" >&5 printf %s "checking whether to use nl_langinfo... " >&6; } if test "$langinfo_ok" = "yes"; then if test ${tcl_cv_langinfo_h+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <langinfo.h> int main (void) { nl_langinfo(CODESET); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_langinfo_h=yes else $as_nop tcl_cv_langinfo_h=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_langinfo_h" >&5 printf "%s\n" "$tcl_cv_langinfo_h" >&6; } if test $tcl_cv_langinfo_h = yes; then printf "%s\n" "#define HAVE_LANGINFO 1" >>confdefs.h fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $langinfo_ok" >&5 printf "%s\n" "$langinfo_ok" >&6; } fi #-------------------------------------------------------------------- # Check for support of cfmakeraw, chflags and mkstemps functions #-------------------------------------------------------------------- ac_fn_c_check_func "$LINENO" "cfmakeraw" "ac_cv_func_cfmakeraw" if test "x$ac_cv_func_cfmakeraw" = xyes then : printf "%s\n" "#define HAVE_CFMAKERAW 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "chflags" "ac_cv_func_chflags" if test "x$ac_cv_func_chflags" = xyes then : printf "%s\n" "#define HAVE_CHFLAGS 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "mkstemps" "ac_cv_func_mkstemps" if test "x$ac_cv_func_mkstemps" = xyes then : printf "%s\n" "#define HAVE_MKSTEMPS 1" >>confdefs.h fi #-------------------------------------------------------------------- # Check for support of isnan() function or macro #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking isnan" >&5 printf %s "checking isnan... " >&6; } if test ${tcl_cv_isnan+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <math.h> int main (void) { isnan(0.0); /* Generates an error if isnan is missing */ ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_isnan=yes else $as_nop tcl_cv_isnan=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_isnan" >&5 printf "%s\n" "$tcl_cv_isnan" >&6; } if test $tcl_cv_isnan = no; then printf "%s\n" "#define NO_ISNAN 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 then : printf "%s\n" "#define HAVE_GETATTRLIST 1" >>confdefs.h fi ac_fn_c_check_header_compile "$LINENO" "copyfile.h" "ac_cv_header_copyfile_h" "$ac_includes_default" if test "x$ac_cv_header_copyfile_h" = xyes then : printf "%s\n" "#define HAVE_COPYFILE_H 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "copyfile" "ac_cv_func_copyfile" if test "x$ac_cv_func_copyfile" = xyes then : printf "%s\n" "#define HAVE_COPYFILE 1" >>confdefs.h fi if test $tcl_corefoundation = yes; then ac_fn_c_check_header_compile "$LINENO" "libkern/OSAtomic.h" "ac_cv_header_libkern_OSAtomic_h" "$ac_includes_default" if test "x$ac_cv_header_libkern_OSAtomic_h" = xyes then : printf "%s\n" "#define HAVE_LIBKERN_OSATOMIC_H 1" >>confdefs.h fi ac_fn_c_check_func "$LINENO" "OSSpinLockLock" "ac_cv_func_OSSpinLockLock" if test "x$ac_cv_func_OSSpinLockLock" = xyes then : printf "%s\n" "#define HAVE_OSSPINLOCKLOCK 1" >>confdefs.h fi fi printf "%s\n" "#define USE_VFORK 1" >>confdefs.h printf "%s\n" "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h printf "%s\n" "#define TCL_WIDE_CLICKS 1" >>confdefs.h ac_fn_c_check_header_compile "$LINENO" "AvailabilityMacros.h" "ac_cv_header_AvailabilityMacros_h" "$ac_includes_default" if test "x$ac_cv_header_AvailabilityMacros_h" = xyes then : printf "%s\n" "#define HAVE_AVAILABILITYMACROS_H 1" >>confdefs.h fi if test "$ac_cv_header_AvailabilityMacros_h" = yes; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if weak import is available" >&5 printf %s "checking if weak import is available... " >&6; } if test ${tcl_cv_cc_weak_import+y} then : printf %s "(cached) " >&6 else $as_nop hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #endif int rand(void) __attribute__((weak_import)); int main (void) { rand(); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_weak_import=yes else $as_nop tcl_cv_cc_weak_import=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_weak_import" >&5 printf "%s\n" "$tcl_cv_cc_weak_import" >&6; } if test $tcl_cv_cc_weak_import = yes; then printf "%s\n" "#define HAVE_WEAK_IMPORT 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if Darwin SUSv3 extensions are available" >&5 printf %s "checking if Darwin SUSv3 extensions are available... " >&6; } if test ${tcl_cv_cc_darwin_c_source+y} then : printf %s "(cached) " >&6 else $as_nop hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #endif #define _DARWIN_C_SOURCE 1 #include <sys/cdefs.h> int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cc_darwin_c_source=yes else $as_nop tcl_cv_cc_darwin_c_source=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext CFLAGS=$hold_cflags fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_darwin_c_source" >&5 printf "%s\n" "$tcl_cv_cc_darwin_c_source" >&6; } if test $tcl_cv_cc_darwin_c_source = yes; then printf "%s\n" "#define _DARWIN_C_SOURCE 1" >>confdefs.h fi fi # Build .bundle dltest binaries in addition to .dylib DLTEST_LD='${CC} -bundle -Wl,-w ${CFLAGS} ${LDFLAGS}' DLTEST_SUFFIX=".bundle" else DLTEST_LD='${SHLIB_LD}' DLTEST_SUFFIX="" fi #-------------------------------------------------------------------- # Check for support of fts functions (readdir replacement) #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for fts" >&5 printf %s "checking for fts... " >&6; } if test ${tcl_cv_api_fts+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/param.h> #include <sys/stat.h> #include <fts.h> int main (void) { char*const p[2] = {"/", NULL}; FTS *f = fts_open(p, FTS_PHYSICAL|FTS_NOCHDIR|FTS_NOSTAT, NULL); FTSENT *e = fts_read(f); fts_close(f); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_api_fts=yes else $as_nop tcl_cv_api_fts=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_fts" >&5 printf "%s\n" "$tcl_cv_api_fts" >&6; } if test $tcl_cv_api_fts = yes; then printf "%s\n" "#define HAVE_FTS 1" >>confdefs.h fi #-------------------------------------------------------------------- # The statements below check for systems where POSIX-style non-blocking # I/O (O_NONBLOCK) doesn't work or is unimplemented. On these systems # (mostly older ones), use the old BSD-style FIONBIO approach instead. #-------------------------------------------------------------------- ac_fn_c_check_header_compile "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default" if test "x$ac_cv_header_sys_ioctl_h" = xyes then : printf "%s\n" "#define HAVE_SYS_IOCTL_H 1" >>confdefs.h fi ac_fn_c_check_header_compile "$LINENO" "sys/filio.h" "ac_cv_header_sys_filio_h" "$ac_includes_default" if test "x$ac_cv_header_sys_filio_h" = xyes then : printf "%s\n" "#define HAVE_SYS_FILIO_H 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking system version" >&5 printf %s "checking system version... " >&6; } if test ${tcl_cv_sys_version+y} then : printf %s "(cached) " >&6 else $as_nop if test "${TEA_PLATFORM}" = "windows" ; then tcl_cv_sys_version=windows else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5 printf "%s\n" "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then tcl_cv_sys_version=NetBSD-Debian fi fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 printf "%s\n" "$tcl_cv_sys_version" >&6; } system=$tcl_cv_sys_version { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 printf %s "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; } case $system in OSF*) printf "%s\n" "#define USE_FIONBIO 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 printf "%s\n" "FIONBIO" >&6; } ;; *) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5 printf "%s\n" "O_NONBLOCK" >&6; } ;; esac #------------------------------------------------------------------------ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use dll unloading" >&5 printf %s "checking whether to use dll unloading... " >&6; } # Check whether --enable-dll-unloading was given. if test ${enable_dll_unloading+y} then : enableval=$enable_dll_unloading; tcl_ok=$enableval else $as_nop tcl_ok=yes fi if test $tcl_ok = yes; then printf "%s\n" "#define TCL_UNLOAD_DLLS 1" >>confdefs.h fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 printf "%s\n" "$tcl_ok" >&6; } #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can # be overridden on the configure command line either way. #------------------------------------------------------------------------ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for timezone data" >&5 printf %s "checking for timezone data... " >&6; } # Check whether --with-tzdata was given. if test ${with_tzdata+y} then : withval=$with_tzdata; tcl_ok=$withval else $as_nop tcl_ok=auto fi # # Any directories that get added here must also be added to the # search path in ::tcl::clock::Initialize (library/clock.tcl). # case $tcl_ok in no) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: supplied by OS vendor" >&5 printf "%s\n" "supplied by OS vendor" >&6; } ;; yes) # nothing to do here ;; auto*) if test ${tcl_cv_dir_zoneinfo+y} then : printf %s "(cached) " >&6 else $as_nop for dir in /usr/share/zoneinfo \ /usr/share/lib/zoneinfo \ /usr/lib/zoneinfo do if test -f $dir/UTC -o -f $dir/GMT then tcl_cv_dir_zoneinfo="$dir" break fi done fi if test -n "$tcl_cv_dir_zoneinfo"; then tcl_ok=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $dir" >&5 printf "%s\n" "$dir" >&6; } else tcl_ok=yes fi ;; *) as_fn_error $? "invalid argument: $tcl_ok" "$LINENO" 5 ;; esac if test $tcl_ok = yes then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: supplied by Tcl" >&5 printf "%s\n" "supplied by Tcl" >&6; } INSTALL_TZDATA=install-tzdata fi #-------------------------------------------------------------------- # DTrace support #-------------------------------------------------------------------- # Check whether --enable-dtrace was given. if test ${enable_dtrace+y} then : enableval=$enable_dtrace; tcl_ok=$enableval else $as_nop tcl_ok=no fi if test $tcl_ok = yes; then ac_fn_c_check_header_compile "$LINENO" "sys/sdt.h" "ac_cv_header_sys_sdt_h" "$ac_includes_default" if test "x$ac_cv_header_sys_sdt_h" = xyes then : tcl_ok=yes else $as_nop tcl_ok=no fi fi if test $tcl_ok = yes; then # Extract the first word of "dtrace", so it can be a program name with args. set dummy dtrace; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_path_DTRACE+y} then : printf %s "(cached) " >&6 else $as_nop case $DTRACE in [\\/]* | ?:[\\/]*) ac_cv_path_DTRACE="$DTRACE" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_dummy="$PATH:/usr/sbin" for as_dir in $as_dummy do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_path_DTRACE="$as_dir$ac_word$ac_exec_ext" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi DTRACE=$ac_cv_path_DTRACE if test -n "$DTRACE"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $DTRACE" >&5 printf "%s\n" "$DTRACE" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -z "$ac_cv_path_DTRACE" && tcl_ok=no fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to enable DTrace support" >&5 printf %s "checking whether to enable DTrace support... " >&6; } MAKEFILE_SHELL='/bin/sh' if test $tcl_ok = yes; then printf "%s\n" "#define USE_DTRACE 1" >>confdefs.h DTRACE_SRC="\${DTRACE_SRC}" DTRACE_HDR="\${DTRACE_HDR}" if test "`uname -s`" != "Darwin" ; then DTRACE_OBJ="\${DTRACE_OBJ}" if test "`uname -s`" = "SunOS" -a "$SHARED_BUILD" = "0" ; then # Need to create an intermediate object file to ensure tclDTrace.o # gets included when linking against the static tcl library. STLIB_LD='stlib_ld () { /usr/ccs/bin/ld -r -o $${1%.a}.o "$${@:2}" && '"${STLIB_LD}"' $${1} $${1%.a}.o ; } && stlib_ld' MAKEFILE_SHELL='/bin/bash' # Force use of Sun ar and ranlib, the GNU versions choke on # tclDTrace.o and the combined object file above. AR='/usr/ccs/bin/ar' RANLIB='/usr/ccs/bin/ranlib' fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 printf "%s\n" "$tcl_ok" >&6; } #-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the cpuid instruction is usable" >&5 printf %s "checking whether the cpuid instruction is usable... " >&6; } if test ${tcl_cv_cpuid+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { int index,regsPtr[4]; __asm__ __volatile__("mov %%ebx, %%edi \n\t" "cpuid \n\t" "mov %%ebx, %%esi \n\t" "mov %%edi, %%ebx \n\t" : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) : "a"(index) : "edi"); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cpuid=yes else $as_nop tcl_cv_cpuid=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cpuid" >&5 printf "%s\n" "$tcl_cv_cpuid" >&6; } if test $tcl_cv_cpuid = yes; then printf "%s\n" "#define HAVE_CPUID 1" >>confdefs.h fi #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- |
︙ | ︙ | |||
10382 10383 10384 10385 10386 10387 10388 | # path name of the Tcl directory rather than "..": this is because # AIX remembers this path and will attempt to use it at run-time to look # up the Tcl library. if test "`uname -s`" = "Darwin" ; then if test "`uname -s`" = "Darwin" ; then | | | | > | | | | | | | | | | | | | 10907 10908 10909 10910 10911 10912 10913 10914 10915 10916 10917 10918 10919 10920 10921 10922 10923 10924 10925 10926 10927 10928 10929 10930 10931 10932 10933 10934 10935 10936 10937 10938 10939 10940 10941 10942 10943 10944 10945 10946 10947 10948 10949 10950 10951 10952 10953 10954 10955 10956 10957 10958 10959 10960 10961 10962 10963 10964 10965 10966 10967 10968 10969 10970 10971 10972 | # path name of the Tcl directory rather than "..": this is because # AIX remembers this path and will attempt to use it at run-time to look # up the Tcl library. if test "`uname -s`" = "Darwin" ; then if test "`uname -s`" = "Darwin" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to package libraries" >&5 printf %s "checking how to package libraries... " >&6; } # Check whether --enable-framework was given. if test ${enable_framework+y} then : enableval=$enable_framework; enable_framework=$enableval else $as_nop enable_framework=no fi if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be built if --enable-shared is yes" >&5 printf "%s\n" "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;} enable_framework=no fi if test $tcl_corefoundation = no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be used when CoreFoundation is available" >&5 printf "%s\n" "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;} enable_framework=no fi fi if test $enable_framework = yes; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: framework" >&5 printf "%s\n" "framework" >&6; } FRAMEWORK_BUILD=1 else if test $SHARED_BUILD = 1; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared library" >&5 printf "%s\n" "shared library" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: static library" >&5 printf "%s\n" "static library" >&6; } fi FRAMEWORK_BUILD=0 fi 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' EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' 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 printf "%s\n" "#define TCL_FRAMEWORK 1" >>confdefs.h # Construct a fake local framework structure to make linking with # '-framework Tcl' and running of tcltest work ac_config_commands="$ac_config_commands Tcl.framework" LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH" # default install directory for bundled packages |
︙ | ︙ | |||
10481 10482 10483 10484 10485 10486 10487 10488 10489 10490 10491 10492 10493 10494 10495 10496 10497 10498 | TCL_LIB_FLAG="-ltcl${TCL_VERSION}" else TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`" fi TCL_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_LIB_FLAG}" TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}" fi VERSION='${VERSION}' eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}" eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}" VERSION=${TCL_VERSION} #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 11007 11008 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 11034 11035 11036 11037 11038 11039 11040 11041 11042 11043 11044 11045 11046 11047 11048 11049 11050 11051 11052 11053 11054 11055 11056 11057 11058 11059 11060 11061 11062 11063 11064 11065 11066 11067 11068 11069 11070 11071 11072 11073 11074 11075 11076 11077 11078 11079 11080 11081 11082 11083 11084 11085 11086 11087 11088 11089 11090 11091 11092 11093 11094 11095 11096 11097 11098 11099 11100 11101 11102 11103 11104 11105 11106 11107 11108 11109 11110 11111 11112 11113 11114 11115 11116 11117 11118 11119 11120 11121 11122 11123 11124 11125 11126 11127 11128 11129 11130 11131 11132 11133 11134 11135 11136 11137 11138 11139 11140 11141 11142 11143 11144 11145 11146 11147 11148 11149 11150 11151 11152 11153 11154 11155 11156 11157 11158 11159 11160 11161 11162 11163 11164 11165 11166 11167 11168 11169 11170 11171 11172 11173 11174 11175 11176 11177 11178 11179 11180 11181 11182 11183 11184 11185 11186 11187 11188 11189 11190 11191 11192 11193 11194 11195 11196 11197 11198 11199 11200 11201 11202 11203 11204 11205 11206 11207 11208 11209 11210 11211 11212 11213 11214 11215 11216 11217 11218 11219 11220 11221 11222 11223 | TCL_LIB_FLAG="-ltcl${TCL_VERSION}" else TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`" fi TCL_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_LIB_FLAG}" TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}" fi VERSION='8.5' eval "TCL_PREV_LIB_FILE=libtcl${TCL_SHARED_LIB_SUFFIX}" eval "TCL_PREV_LIB_FILE=${TCL_PREV_LIB_FILE}" VERSION='${VERSION}' eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}" eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}" VERSION=${TCL_VERSION} #-------------------------------------------------------------------- # Zipfs support - Tip 430 #-------------------------------------------------------------------- # Check whether --enable-zipfs was given. if test ${enable_zipfs+y} then : enableval=$enable_zipfs; tcl_ok=$enableval else $as_nop tcl_ok=yes fi if test "$tcl_ok" = "yes" -a "x$enable_framework" != "xyes"; then # # Find a native compiler # # Put a plausible default for CC_FOR_BUILD in Makefile. if test -z "$CC_FOR_BUILD"; then if test "x$cross_compiling" = "xno"; then CC_FOR_BUILD='$(CC)' else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 printf %s "checking for gcc... " >&6; } if test ${ac_cv_path_cc+y} then : printf %s "(cached) " >&6 else $as_nop search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/gcc 2> /dev/null` \ `ls -r $dir/gcc 2> /dev/null` ; do if test x"$ac_cv_path_cc" = x ; then if test -f "$j" ; then ac_cv_path_cc=$j break fi fi done done fi fi fi # Also set EXEEXT_FOR_BUILD. if test "x$cross_compiling" = "xno"; then EXEEXT_FOR_BUILD='$(EXEEXT)' OBJEXT_FOR_BUILD='$(OBJEXT)' else OBJEXT_FOR_BUILD='.no' { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 printf %s "checking for build system executable suffix... " >&6; } if test ${bfd_cv_build_exeext+y} then : printf %s "(cached) " >&6 else $as_nop rm -f conftest* echo 'int main () { return 0; }' > conftest.c bfd_cv_build_exeext= ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 for file in conftest.*; do case $file in *.c | *.o | *.obj | *.ilk | *.pdb) ;; *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; esac done rm -f conftest* test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 printf "%s\n" "$bfd_cv_build_exeext" >&6; } EXEEXT_FOR_BUILD="" test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} fi # # Find a native zip implementation # MACHER_PROG="" ZIP_PROG="" ZIP_PROG_OPTIONS="" ZIP_PROG_VFSSEARCH="" ZIP_INSTALL_OBJS="" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for macher" >&5 printf %s "checking for macher... " >&6; } if test ${ac_cv_path_macher+y} then : printf %s "(cached) " >&6 else $as_nop search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/macher 2> /dev/null` \ `ls -r $dir/macher 2> /dev/null` ; do if test x"$ac_cv_path_macher" = x ; then if test -f "$j" ; then ac_cv_path_macher=$j break fi fi done done fi if test -f "$ac_cv_path_macher" ; then MACHER_PROG="$ac_cv_path_macher" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $MACHER_PROG" >&5 printf "%s\n" "$MACHER_PROG" >&6; } { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Found macher in environment" >&5 printf "%s\n" "Found macher in environment" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 printf %s "checking for zip... " >&6; } if test ${ac_cv_path_zip+y} then : printf %s "(cached) " >&6 else $as_nop search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/zip 2> /dev/null` \ `ls -r $dir/zip 2> /dev/null` ; do if test x"$ac_cv_path_zip" = x ; then if test -f "$j" ; then ac_cv_path_zip=$j break fi fi done done fi if test -f "$ac_cv_path_zip" ; then ZIP_PROG="$ac_cv_path_zip" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 printf "%s\n" "$ZIP_PROG" >&6; } ZIP_PROG_OPTIONS="-rq" ZIP_PROG_VFSSEARCH="*" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5 printf "%s\n" "Found INFO Zip in environment" >&6; } # Use standard arguments for zip else # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}" ZIP_PROG_OPTIONS="-o -r" ZIP_PROG_VFSSEARCH="*" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH. Building minizip" >&5 printf "%s\n" "No zip found on PATH. Building minizip" >&6; } fi ZIPFS_BUILD=1 TCL_ZIP_FILE=libtcl${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_PATCH_LEVEL}.zip else ZIPFS_BUILD=0 TCL_ZIP_FILE= fi # Do checking message here to not mess up interleaved configure output { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 printf %s "checking for building with zipfs... " >&6; } if test "${ZIPFS_BUILD}" = 1; then if test "${SHARED_BUILD}" = 0; then ZIPFS_BUILD=2; printf "%s\n" "#define ZIPFS_BUILD 2" >>confdefs.h else printf "%s\n" "#define ZIPFS_BUILD 1" >>confdefs.h \ fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } INSTALL_LIBRARIES=install-libraries INSTALL_MSGS=install-msgs fi #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- |
︙ | ︙ | |||
10596 10597 10598 10599 10600 10601 10602 10603 10604 10605 10606 10607 10608 10609 | ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. | > | 11321 11322 11323 11324 11325 11326 11327 11328 11329 11330 11331 11332 11333 11334 11335 | ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. |
︙ | ︙ | |||
10626 10627 10628 10629 10630 10631 10632 | # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( | | | | 11352 11353 11354 11355 11356 11357 11358 11359 11360 11361 11362 11363 11364 11365 11366 11367 | # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac |
︙ | ︙ | |||
10657 10658 10659 10660 10661 10662 10663 | esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear | | | | | | | 11383 11384 11385 11386 11387 11388 11389 11390 11391 11392 11393 11394 11395 11396 11397 11398 11399 11400 11401 11402 11403 11404 11405 11406 11407 11408 11409 11410 11411 11412 11413 11414 11415 11416 11417 11418 11419 11420 | esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then if test "x$cache_file" != "x/dev/null"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 printf "%s\n" "$as_me: updating cache $cache_file" >&6;} if test ! -f "$cache_file" || test -h "$cache_file"; then cat confcache >"$cache_file" else case $cache_file in #( */* | ?:*) mv -f confcache "$cache_file"$$ && mv -f "$cache_file"$$ "$cache_file" ;; #( *) mv -f confcache "$cache_file" ;; esac fi fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' |
︙ | ︙ | |||
10735 10736 10737 10738 10739 10740 10741 | CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS="" : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" | | | | 11461 11462 11463 11464 11465 11466 11467 11468 11469 11470 11471 11472 11473 11474 11475 11476 | CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS="" : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} as_write_fail=0 cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. |
︙ | ︙ | |||
10759 10760 10761 10762 10763 10764 10765 | cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh | > | > | > > > > > > > > < < < < < < < < | | < | | < < < < < < | < < < < < < < | > > | < < > | | > > > > > > > > > | > > > > | < < < < < < < > | > > > | | < < < < < < < < < < < < < < < < < < < < | | > | 11485 11486 11487 11488 11489 11490 11491 11492 11493 11494 11495 11496 11497 11498 11499 11500 11501 11502 11503 11504 11505 11506 11507 11508 11509 11510 11511 11512 11513 11514 11515 11516 11517 11518 11519 11520 11521 11522 11523 11524 11525 11526 11527 11528 11529 11530 11531 11532 11533 11534 11535 11536 11537 11538 11539 11540 11541 11542 11543 11544 11545 11546 11547 11548 11549 11550 11551 11552 11553 11554 11555 11556 11557 11558 11559 11560 11561 11562 11563 11564 11565 11566 11567 11568 11569 11570 11571 11572 11573 11574 11575 11576 11577 11578 11579 11580 11581 11582 11583 11584 11585 11586 11587 11588 11589 11590 11591 11592 11593 11594 11595 11596 11597 11598 11599 11600 11601 11602 11603 11604 11605 11606 11607 11608 11609 11610 11611 11612 | cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else $as_nop case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { |
︙ | ︙ | |||
10921 10922 10923 10924 10925 10926 10927 10928 10929 10930 10931 10932 10933 | # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. | > | > | | > | | 11627 11628 11629 11630 11631 11632 11633 11634 11635 11636 11637 11638 11639 11640 11641 11642 11643 11644 11645 11646 11647 11648 11649 11650 11651 11652 11653 11654 11655 11656 11657 11658 11659 11660 11661 11662 11663 11664 11665 11666 11667 11668 11669 11670 11671 11672 | # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else $as_nop as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else $as_nop as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith |
︙ | ︙ | |||
10980 10981 10982 10983 10984 10985 10986 | as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || | | | 11689 11690 11691 11692 11693 11694 11695 11696 11697 11698 11699 11700 11701 11702 11703 | as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q |
︙ | ︙ | |||
11002 11003 11004 11005 11006 11007 11008 11009 11010 11011 11012 11013 11014 11015 11016 11017 11018 11019 11020 11021 11022 11023 11024 11025 11026 11027 | # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null | > > > > > > > > > > | 11711 11712 11713 11714 11715 11716 11717 11718 11719 11720 11721 11722 11723 11724 11725 11726 11727 11728 11729 11730 11731 11732 11733 11734 11735 11736 11737 11738 11739 11740 11741 11742 11743 11744 11745 11746 | # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null |
︙ | ︙ | |||
11056 11057 11058 11059 11060 11061 11062 | case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( | | | | 11775 11776 11777 11778 11779 11780 11781 11782 11783 11784 11785 11786 11787 11788 11789 11790 11791 11792 11793 11794 11795 11796 11797 11798 | case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q |
︙ | ︙ | |||
11128 11129 11130 11131 11132 11133 11134 | cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by tcl $as_me 9.0, which was | | | 11847 11848 11849 11850 11851 11852 11853 11854 11855 11856 11857 11858 11859 11860 11861 | cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by tcl $as_me 9.0, which was generated by GNU Autoconf 2.70. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ |
︙ | ︙ | |||
11181 11182 11183 11184 11185 11186 11187 11188 | Configuration commands: $config_commands Report bugs to the package provider." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 | > > | | | | 11900 11901 11902 11903 11904 11905 11906 11907 11908 11909 11910 11911 11912 11913 11914 11915 11916 11917 11918 11919 11920 11921 11922 11923 | Configuration commands: $config_commands Report bugs to the package provider." _ACEOF ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.70, with options \\"\$ac_cs_config\\" Copyright (C) 2020 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 |
︙ | ︙ | |||
11225 11226 11227 11228 11229 11230 11231 | esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) | | | | | | 11946 11947 11948 11949 11950 11951 11952 11953 11954 11955 11956 11957 11958 11959 11960 11961 11962 11963 11964 11965 11966 11967 11968 11969 11970 11971 11972 11973 11974 | esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) printf "%s\n" "$ac_cs_version"; exit ;; --config | --confi | --conf | --con | --co | --c ) printf "%s\n" "$ac_cs_config"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; --he | --h | --help | --hel | -h ) printf "%s\n" "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) as_fn_error $? "unrecognized option: \`$1' Try \`$0 --help' for more information." ;; |
︙ | ︙ | |||
11267 11268 11269 11270 11271 11272 11273 | fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift | | | | 11988 11989 11990 11991 11992 11993 11994 11995 11996 11997 11998 11999 12000 12001 12002 12003 12004 12005 12006 12007 12008 12009 12010 12011 12012 12013 12014 12015 12016 | fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' export CONFIG_SHELL exec "\$@" fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX printf "%s\n" "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # # INIT-COMMANDS # |
︙ | ︙ | |||
11317 11318 11319 11320 11321 11322 11323 | # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then | | | | 12038 12039 12040 12041 12042 12043 12044 12045 12046 12047 12048 12049 12050 12051 12052 12053 | # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files test ${CONFIG_COMMANDS+y} || CONFIG_COMMANDS=$config_commands fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: |
︙ | ︙ | |||
11546 11547 11548 11549 11550 11551 11552 | test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac | | | | | | | | 12267 12268 12269 12270 12271 12272 12273 12274 12275 12276 12277 12278 12279 12280 12281 12282 12283 12284 12285 12286 12287 12288 12289 12290 12291 12292 12293 12294 12295 12296 12297 12298 12299 12300 12301 12302 12303 12304 12305 12306 12307 12308 12309 12310 12311 12312 12313 12314 12315 12316 | test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 printf "%s\n" "$as_me: creating $ac_file" >&6;} fi # Neutralize special characters interpreted by sed in replacement strings. case $configure_input in #( *\&* | *\|* | *\\* ) ac_sed_conf_input=`printf "%s\n" "$configure_input" | sed 's/[\\\\&|]/\\\\&/g'`;; #( *) ac_sed_conf_input=$configure_input;; esac case $ac_tag in *:-:* | *:-) cat >"$ac_tmp/stdin" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q |
︙ | ︙ | |||
11605 11606 11607 11608 11609 11610 11611 | s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) | | | | 12326 12327 12328 12329 12330 12331 12332 12333 12334 12335 12336 12337 12338 12339 12340 12341 12342 | s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix |
︙ | ︙ | |||
11660 11661 11662 11663 11664 11665 11666 | /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) | | | | 12381 12382 12383 12384 12385 12386 12387 12388 12389 12390 12391 12392 12393 12394 12395 12396 | /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g |
︙ | ︙ | |||
11703 11704 11705 11706 11707 11708 11709 | eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && | | | | | | 12424 12425 12426 12427 12428 12429 12430 12431 12432 12433 12434 12435 12436 12437 12438 12439 12440 12441 12442 12443 12444 12445 12446 12447 12448 12449 12450 12451 12452 12453 | eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&5 printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" case $ac_file in -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; :C) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 printf "%s\n" "$as_me: executing $ac_file commands" >&6;} ;; esac case $ac_file$ac_mode in "Tcl.framework":C) n=Tcl && f=$n.framework && v=Versions/$VERSION && |
︙ | ︙ | |||
11765 11766 11767 11768 11769 11770 11771 | $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then | | | > | 12486 12487 12488 12489 12490 12491 12492 12493 12494 12495 12496 12497 12498 | $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi |
Changes to unix/configure.ac.
1 2 3 4 5 6 | #! /bin/bash -norc dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. AC_INIT([tcl],[9.0]) | | | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | #! /bin/bash -norc dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. AC_INIT([tcl],[9.0]) AC_PREREQ([2.69]) dnl This is only used when included from macosx/configure.ac m4_ifdef([SC_USE_CONFIG_HEADERS], [ AC_CONFIG_HEADERS([tclConfig.h:../unix/tclConfig.h.in]) AC_CONFIG_COMMANDS_PRE([DEFS="-DHAVE_TCL_CONFIG_H -imacros tclConfig.h"]) AH_TOP([ #ifndef _TCLCONFIG #define _TCLCONFIG]) AH_BOTTOM([ /* Undef unused package specific autoheader defines so that we can * include both tclConfig.h and tkConfig.h at the same time: */ /* override */ #undef PACKAGE_NAME /* override */ #undef PACKAGE_TARNAME /* override */ #undef PACKAGE_VERSION /* override */ #undef PACKAGE_STRING #endif /* _TCLCONFIG */]) ]) TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 TCL_PATCH_LEVEL="a2" |
︙ | ︙ | |||
109 110 111 112 113 114 115 | # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ if test -z "$no_pipe" && test -n "$GCC"; then AC_CACHE_CHECK([if the compiler understands -pipe], tcl_cv_cc_pipe, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" | | | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ if test -z "$no_pipe" && test -n "$GCC"; then AC_CACHE_CHECK([if the compiler understands -pipe], tcl_cv_cc_pipe, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_pipe=yes],[tcl_cv_cc_pipe=no]) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_pipe = yes; then CFLAGS="$CFLAGS -pipe" fi fi #------------------------------------------------------------------------ |
︙ | ︙ | |||
168 169 170 171 172 173 174 | AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) #------------------------------------------------------------------------ # Add stuff for libtommath libtommath_ok=yes AC_ARG_WITH(system-libtommath, | | | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 | AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) #------------------------------------------------------------------------ # Add stuff for libtommath libtommath_ok=yes AC_ARG_WITH(system-libtommath, AS_HELP_STRING([--with-system-libtommath], [use external libtommath (default: true if available, false otherwise)]), [libtommath_ok=${withval}]) if test x"${libtommath_ok}" = x -o x"${libtommath_ok}" != xno; then AC_CHECK_HEADER([tommath.h],[ AC_CHECK_TYPE([mp_int],[],[libtommath_ok=no],[#include <tommath.h>])],[ libtommath_ok=no]) AS_IF([test $libtommath_ok = yes], [ AC_CHECK_LIB([tommath],[mp_log_u32],[MATH_LIBS="$MATH_LIBS -ltommath"],[ libtommath_ok=no])]) |
︙ | ︙ | |||
297 298 299 300 301 302 303 | # systems like OSF/1 have a sys/select.h that's of no use, and # other systems like SCO UNIX have a sys/select.h that's # pernicious. If "fd_set" isn't defined anywhere then set a # special flag. #-------------------------------------------------------------------- AC_CACHE_CHECK([for fd_set in sys/types], tcl_cv_type_fd_set, [ | | | | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 | # systems like OSF/1 have a sys/select.h that's of no use, and # other systems like SCO UNIX have a sys/select.h that's # pernicious. If "fd_set" isn't defined anywhere then set a # special flag. #-------------------------------------------------------------------- AC_CACHE_CHECK([for fd_set in sys/types], tcl_cv_type_fd_set, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>]], [[fd_set readMask, writeMask;]])], [tcl_cv_type_fd_set=yes],[tcl_cv_type_fd_set=no])]) tcl_ok=$tcl_cv_type_fd_set if test $tcl_ok = no; then AC_CACHE_CHECK([for fd_mask in sys/select], tcl_cv_grep_fd_mask, [ AC_EGREP_HEADER(fd_mask, sys/select.h, tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing)]) if test $tcl_cv_grep_fd_mask = present; then AC_DEFINE(HAVE_SYS_SELECT_H, 1, [Should we include <sys/select.h>?]) |
︙ | ︙ | |||
409 410 411 412 413 414 415 | AC_TYPE_MODE_T AC_TYPE_PID_T AC_TYPE_SIZE_T AC_TYPE_UID_T AC_CACHE_CHECK([for socklen_t], tcl_cv_type_socklen_t, [ | | | | | < < < < < < < < < < < < < < | < < < < < < < < < < < < < < | | | | | 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 | AC_TYPE_MODE_T AC_TYPE_PID_T AC_TYPE_SIZE_T AC_TYPE_UID_T AC_CACHE_CHECK([for socklen_t], tcl_cv_type_socklen_t, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> #include <sys/socket.h> ]], [[ socklen_t foo; ]])],[tcl_cv_type_socklen_t=yes],[tcl_cv_type_socklen_t=no])]) if test $tcl_cv_type_socklen_t = no; then AC_DEFINE(socklen_t, int, [Define as int if socklen_t is not available]) fi AC_CHECK_TYPES([intptr_t, uintptr_t],,,[[ #include <stdint.h> ]]) #-------------------------------------------------------------------- # If a system doesn't have an opendir function (man, that's old!) # then we have to supply a different version of dirent.h which # is compatible with the substitute version of opendir that's # provided. This version only works with V7-style directories. #-------------------------------------------------------------------- AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H, 1, [May we include <dirent2.h>?])]) #-------------------------------------------------------------------- # The check below checks whether <sys/wait.h> defines the type # "union wait" correctly. It's needed because of weirdness in # HP-UX where "union wait" is defined in both the BSD and SYS-V # environments. Checking the usability of WIFEXITED seems to do # the trick. #-------------------------------------------------------------------- AC_CACHE_CHECK([union wait], tcl_cv_union_wait, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h> #include <sys/wait.h>]], [[ union wait x; WIFEXITED(x); /* Generates compiler error if WIFEXITED * uses an int. */ ]])],[tcl_cv_union_wait=yes],[tcl_cv_union_wait=no])]) if test $tcl_cv_union_wait = no; then AC_DEFINE(NO_UNION_WAIT, 1, [Do we have a usable 'union wait'?]) fi #-------------------------------------------------------------------- # Check whether there is an strncasecmp function on this system. # This is a bit tricky because under SCO it's in -lsocket and |
︙ | ︙ | |||
524 525 526 527 528 529 530 | # The following code checks to see whether it is possible to get # signed chars on this platform. This is needed in order to # properly generate sign-extended ints from character values. #-------------------------------------------------------------------- AC_C_CHAR_UNSIGNED AC_CACHE_CHECK([signed char declarations], tcl_cv_char_signed, [ | | | | | | | | | 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 | # The following code checks to see whether it is possible to get # signed chars on this platform. This is needed in order to # properly generate sign-extended ints from character values. #-------------------------------------------------------------------- AC_C_CHAR_UNSIGNED AC_CACHE_CHECK([signed char declarations], tcl_cv_char_signed, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[ signed char *p; p = 0; ]])],[tcl_cv_char_signed=yes],[tcl_cv_char_signed=no])]) if test $tcl_cv_char_signed = yes; then AC_DEFINE(HAVE_SIGNED_CHAR, 1, [Are characters signed?]) fi #-------------------------------------------------------------------- # Does putenv() copy or not? We need to know to avoid memory leaks. #-------------------------------------------------------------------- AC_CACHE_CHECK([for a putenv() that copies the buffer], tcl_cv_putenv_copy, [ AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include <stdlib.h> #include <string.h> #define OURVAR "havecopy=yes" int main (int argc, char *argv[]) { char *foo, *bar; foo = (char *)strdup(OURVAR); putenv(foo); strcpy((char *)(strchr(foo, '=') + 1), "no"); bar = getenv("havecopy"); if (!strcmp(bar, "no")) { /* doesnt copy */ return 0; } else { /* does copy */ return 1; } } ]])], [tcl_cv_putenv_copy=no], [tcl_cv_putenv_copy=yes], [tcl_cv_putenv_copy=no])]) if test $tcl_cv_putenv_copy = yes; then AC_DEFINE(HAVE_PUTENV_THAT_COPIES, 1, [Does putenv() copy strings or incorporate them by reference?]) fi #-------------------------------------------------------------------- # Check for support of nl_langinfo function |
︙ | ︙ | |||
582 583 584 585 586 587 588 | AC_CHECK_FUNCS(cfmakeraw chflags mkstemps) #-------------------------------------------------------------------- # Check for support of isnan() function or macro #-------------------------------------------------------------------- AC_CACHE_CHECK([isnan], tcl_cv_isnan, [ | | | | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 | AC_CHECK_FUNCS(cfmakeraw chflags mkstemps) #-------------------------------------------------------------------- # Check for support of isnan() function or macro #-------------------------------------------------------------------- AC_CACHE_CHECK([isnan], tcl_cv_isnan, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <math.h>]], [[ isnan(0.0); /* Generates an error if isnan is missing */ ]])],[tcl_cv_isnan=yes],[tcl_cv_isnan=no])]) if test $tcl_cv_isnan = no; then AC_DEFINE(NO_ISNAN, 1, [Do we have a usable 'isnan'?]) fi #-------------------------------------------------------------------- # Darwin specific API checks and defines #-------------------------------------------------------------------- |
︙ | ︙ | |||
610 611 612 613 614 615 616 | [Can this platform load code from memory?]) AC_DEFINE(TCL_WIDE_CLICKS, 1, [Does this platform have wide high-resolution clicks?]) AC_CHECK_HEADERS(AvailabilityMacros.h) if test "$ac_cv_header_AvailabilityMacros_h" = yes; then AC_CACHE_CHECK([if weak import is available], tcl_cv_cc_weak_import, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" | | | | | | | | | | | | 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 | [Can this platform load code from memory?]) AC_DEFINE(TCL_WIDE_CLICKS, 1, [Does this platform have wide high-resolution clicks?]) AC_CHECK_HEADERS(AvailabilityMacros.h) if test "$ac_cv_header_AvailabilityMacros_h" = yes; then AC_CACHE_CHECK([if weak import is available], tcl_cv_cc_weak_import, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_LINK_IFELSE([AC_LANG_PROGRAM([[ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #endif int rand(void) __attribute__((weak_import)); ]], [[rand();]])], [tcl_cv_cc_weak_import=yes],[tcl_cv_cc_weak_import=no]) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_weak_import = yes; then AC_DEFINE(HAVE_WEAK_IMPORT, 1, [Is weak import available?]) fi AC_CACHE_CHECK([if Darwin SUSv3 extensions are available], tcl_cv_cc_darwin_c_source, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #endif #define _DARWIN_C_SOURCE 1 #include <sys/cdefs.h> ]], [[]])],[tcl_cv_cc_darwin_c_source=yes],[tcl_cv_cc_darwin_c_source=no]) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_darwin_c_source = yes; then AC_DEFINE(_DARWIN_C_SOURCE, 1, [Are Darwin SUSv3 extensions available?]) fi fi # Build .bundle dltest binaries in addition to .dylib DLTEST_LD='${CC} -bundle -Wl,-w ${CFLAGS} ${LDFLAGS}' DLTEST_SUFFIX=".bundle" else DLTEST_LD='${SHLIB_LD}' DLTEST_SUFFIX="" fi #-------------------------------------------------------------------- # Check for support of fts functions (readdir replacement) #-------------------------------------------------------------------- AC_CACHE_CHECK([for fts], tcl_cv_api_fts, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[ #include <sys/param.h> #include <sys/stat.h> #include <fts.h> ]], [[ char*const p[2] = {"/", NULL}; FTS *f = fts_open(p, FTS_PHYSICAL|FTS_NOCHDIR|FTS_NOSTAT, NULL); FTSENT *e = fts_read(f); fts_close(f); ]])],[tcl_cv_api_fts=yes],[tcl_cv_api_fts=no])]) if test $tcl_cv_api_fts = yes; then AC_DEFINE(HAVE_FTS, 1, [Do we have fts functions?]) fi #-------------------------------------------------------------------- # The statements below check for systems where POSIX-style non-blocking # I/O (O_NONBLOCK) doesn't work or is unimplemented. On these systems # (mostly older ones), use the old BSD-style FIONBIO approach instead. #-------------------------------------------------------------------- SC_BLOCKING_STYLE #------------------------------------------------------------------------ AC_MSG_CHECKING([whether to use dll unloading]) AC_ARG_ENABLE(dll-unloading, AS_HELP_STRING([--enable-dll-unloading], [enable the 'unload' command (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) if test $tcl_ok = yes; then AC_DEFINE(TCL_UNLOAD_DLLS, 1, [Do we allow unloading of shared libraries?]) fi AC_MSG_RESULT([$tcl_ok]) #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can # be overridden on the configure command line either way. #------------------------------------------------------------------------ AC_MSG_CHECKING([for timezone data]) AC_ARG_WITH(tzdata, AS_HELP_STRING([--with-tzdata], [install timezone data (default: autodetect)]), [tcl_ok=$withval], [tcl_ok=auto]) # # Any directories that get added here must also be added to the # search path in ::tcl::clock::Initialize (library/clock.tcl). # case $tcl_ok in |
︙ | ︙ | |||
747 748 749 750 751 752 753 | fi #-------------------------------------------------------------------- # DTrace support #-------------------------------------------------------------------- AC_ARG_ENABLE(dtrace, | | | 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 | fi #-------------------------------------------------------------------- # DTrace support #-------------------------------------------------------------------- AC_ARG_ENABLE(dtrace, AS_HELP_STRING([--enable-dtrace], [build with DTrace support (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) if test $tcl_ok = yes; then AC_CHECK_HEADER(sys/sdt.h, [tcl_ok=yes], [tcl_ok=no]) fi if test $tcl_ok = yes; then AC_PATH_PROG(DTRACE, dtrace,, [$PATH:/usr/sbin]) |
︙ | ︙ | |||
778 779 780 781 782 783 784 785 786 | # tclDTrace.o and the combined object file above. AR='/usr/ccs/bin/ar' RANLIB='/usr/ccs/bin/ranlib' fi fi fi AC_MSG_RESULT([$tcl_ok]) #-------------------------------------------------------------------- | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | 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 | # tclDTrace.o and the combined object file above. AR='/usr/ccs/bin/ar' RANLIB='/usr/ccs/bin/ranlib' fi fi fi AC_MSG_RESULT([$tcl_ok]) #-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[ int index,regsPtr[4]; __asm__ __volatile__("mov %%ebx, %%edi \n\t" "cpuid \n\t" "mov %%ebx, %%esi \n\t" "mov %%edi, %%ebx \n\t" : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) : "a"(index) : "edi"); ]])],[tcl_cv_cpuid=yes],[tcl_cv_cpuid=no])]) if test $tcl_cv_cpuid = yes; then AC_DEFINE(HAVE_CPUID, 1, [Is the cpuid instruction usable?]) fi #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. |
︙ | ︙ | |||
937 938 939 940 941 942 943 944 945 946 947 948 949 950 | TCL_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_LIB_FLAG}" TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}" fi VERSION='${VERSION}' eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}" eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}" VERSION=${TCL_VERSION} #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | TCL_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_LIB_FLAG}" TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}" fi VERSION='${VERSION}' eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}" eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}" VERSION=${TCL_VERSION} #-------------------------------------------------------------------- # Zipfs support - Tip 430 #-------------------------------------------------------------------- AC_ARG_ENABLE(zipfs, AS_HELP_STRING([--enable-zipfs], [build with Zipfs support (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes" -a "x$enable_framework" != "xyes"; then # # Find a native compiler # AX_CC_FOR_BUILD # # Find a native zip implementation # SC_ZIPFS_SUPPORT ZIPFS_BUILD=1 TCL_ZIP_FILE=libtcl${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_PATCH_LEVEL}.zip else ZIPFS_BUILD=0 TCL_ZIP_FILE= fi # Do checking message here to not mess up interleaved configure output AC_MSG_CHECKING([for building with zipfs]) if test "${ZIPFS_BUILD}" = 1; then if test "${SHARED_BUILD}" = 0; then ZIPFS_BUILD=2; AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) else AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ fi AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) INSTALL_LIBRARIES=install-libraries INSTALL_MSGS=install-msgs fi AC_SUBST(ZIPFS_BUILD) AC_SUBST(TCL_ZIP_FILE) AC_SUBST(INSTALL_LIBRARIES) AC_SUBST(INSTALL_MSGS) #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- |
︙ | ︙ |
Changes to unix/dltest/Makefile.in.
︙ | ︙ | |||
21 22 23 24 25 26 27 | LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} | | | > > > > > > | 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 | LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} all: embtest tcl9pkgπ${SHLIB_SUFFIX} tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} tcl9pkgooa${SHLIB_SUFFIX} @if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi @touch ../dltest.marker dltest_suffix: tcl9pkgπ${DLTEST_SUFFIX} tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} tcl9pkgooa${DLTEST_SUFFIX} @touch ../dltest.marker embtest.o: $(SRC_DIR)/embtest.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/embtest.c pkgπ.o: $(SRC_DIR)/pkgπ.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgπ.c pkga.o: $(SRC_DIR)/pkga.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c pkgb.o: $(SRC_DIR)/pkgb.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c pkgc.o: $(SRC_DIR)/pkgc.c |
︙ | ︙ | |||
49 50 51 52 53 54 55 | pkgua.o: $(SRC_DIR)/pkgua.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c pkgooa.o: $(SRC_DIR)/pkgooa.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c | > > > > > > | | | | | | | | | | | | | | > > > | | | | | | | | | | | | | | | | 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 | pkgua.o: $(SRC_DIR)/pkgua.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c pkgooa.o: $(SRC_DIR)/pkgooa.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c embtest: embtest.o $(CC) -o $@ embtest.o ${SHLIB_LD_LIBS} tcl9pkgπ${SHLIB_SUFFIX}: pkgπ.o ${SHLIB_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} tcl9pkga${SHLIB_SUFFIX}: pkga.o ${SHLIB_LD} -o $@ pkga.o ${SHLIB_LD_LIBS} tcl9pkgb${SHLIB_SUFFIX}: pkgb.o ${SHLIB_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} tcl9pkgc${SHLIB_SUFFIX}: pkgc.o ${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} tcl9pkgd${SHLIB_SUFFIX}: pkgd.o ${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} tcl9pkge${SHLIB_SUFFIX}: pkge.o ${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} tcl9pkgua${SHLIB_SUFFIX}: pkgua.o ${SHLIB_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} tcl9pkgooa${SHLIB_SUFFIX}: pkgooa.o ${SHLIB_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} tcl9pkgπ${DLTEST_SUFFIX}: pkgπ.o ${DLTEST_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} tcl9pkga${DLTEST_SUFFIX}: pkga.o ${DLTEST_LD} -o $@ pkga.o ${SHLIB_LD_LIBS} tcl9pkgb${DLTEST_SUFFIX}: pkgb.o ${DLTEST_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} tcl9pkgc${DLTEST_SUFFIX}: pkgc.o ${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} tcl9pkgd${DLTEST_SUFFIX}: pkgd.o ${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} tcl9pkge${DLTEST_SUFFIX}: pkge.o ${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} tcl9pkgua${DLTEST_SUFFIX}: pkgua.o ${DLTEST_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} tcl9pkgooa${DLTEST_SUFFIX}: pkgooa.o ${DLTEST_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} clean: rm -f embtest *.o lib.exp ../dltest.marker @if test "$(SHLIB_SUFFIX)" != ""; then \ echo "rm -f *${SHLIB_SUFFIX}" ; \ rm -f *${SHLIB_SUFFIX} ; \ fi @if test "$(DLTEST_SUFFIX)" != ""; then \ echo "rm -f *${DLTEST_SUFFIX}" ; \ rm -f *${DLTEST_SUFFIX} ; \ fi distclean: clean rm -f Makefile |
Added unix/dltest/embtest.c.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | #include "tcl.h" #include <stdio.h> MODULE_SCOPE const TclStubs *tclStubsPtr; int main(int argc, char **argv) { const char *version; int exitcode = 0; if (tclStubsPtr != NULL) { printf("ERROR: stub table is already initialized"); exitcode = 1; } tclStubsPtr = NULL; version = Tcl_SetPanicProc(Tcl_ConsolePanic); if (tclStubsPtr == NULL) { printf("ERROR: Tcl_SetPanicProc does not initialize the stub table\n"); exitcode = 1; } tclStubsPtr = NULL; version = Tcl_InitSubsystems(); if (tclStubsPtr == NULL) { printf("ERROR: Tcl_InitSubsystems does not initialize the stub table\n"); exitcode = 1; } tclStubsPtr = NULL; version = Tcl_FindExecutable(argv[0]); if (tclStubsPtr == NULL) { printf("ERROR: Tcl_FindExecutable does not initialize the stub table\n"); exitcode = 1; } if (!exitcode) { printf("All OK!\n"); } return exitcode; } |
Changes to unix/dltest/pkga.c.
1 2 3 4 5 6 | /* * pkga.c -- * * This file contains a simple Tcl package "pkga" that is intended for * testing the Tcl dynamic loading facilities. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * pkga.c -- * * This file contains a simple Tcl package "pkga" that is intended for * testing the Tcl dynamic loading facilities. * * Copyright © 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" |
︙ | ︙ | |||
125 126 127 128 129 130 131 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } | | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkga", "1.0"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd, NULL, NULL); return TCL_OK; } |
Changes to unix/dltest/pkgb.c.
1 2 3 | /* * pkgb.c -- * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * pkgb.c -- * * This file contains a simple Tcl package "Pkgb" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright © 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" |
︙ | ︙ | |||
148 149 150 151 152 153 154 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } | | | 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgb", "2.3"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL); return TCL_OK; |
︙ | ︙ | |||
185 186 187 188 189 190 191 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } | | | 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgb", "2.3"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL); return TCL_OK; } |
Changes to unix/dltest/pkgc.c.
1 2 3 4 5 6 7 | /* * pkgc.c -- * * This file contains a simple Tcl package "pkgc" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * pkgc.c -- * * This file contains a simple Tcl package "pkgc" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright © 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" |
︙ | ︙ | |||
117 118 119 120 121 122 123 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } | | | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgc", "1.7.2"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd, NULL, NULL); return TCL_OK; |
︙ | ︙ | |||
154 155 156 157 158 159 160 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } | | | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgc", "1.7.2"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL); return TCL_OK; } |
Changes to unix/dltest/pkgd.c.
1 2 3 | /* * pkgd.c -- * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * pkgd.c -- * * This file contains a simple Tcl package "PKGD" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright © 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" |
︙ | ︙ | |||
117 118 119 120 121 122 123 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } | | | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgd", "7.3"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd, NULL, NULL); return TCL_OK; |
︙ | ︙ | |||
154 155 156 157 158 159 160 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } | | | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | * made available. */ { int code; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgd", "7.3"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL); return TCL_OK; } |
Changes to unix/dltest/pkge.c.
1 2 3 4 5 6 7 | /* * pkge.c -- * * This file contains a simple Tcl package "pkge" that is intended for * testing the Tcl dynamic loading facilities. Its Init procedure returns * an error in order to test how this is handled. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * pkge.c -- * * This file contains a simple Tcl package "pkge" that is intended for * testing the Tcl dynamic loading facilities. Its Init procedure returns * an error in order to test how this is handled. * * Copyright © 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" |
︙ | ︙ |
Changes to unix/dltest/pkgooa.c.
1 2 3 4 5 6 | /* * pkgooa.c -- * * This file contains a simple Tcl package "pkgooa" that is intended for * testing the Tcl dynamic loading facilities. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * pkgooa.c -- * * This file contains a simple Tcl package "pkgooa" that is intended for * testing the Tcl dynamic loading facilities. * * Copyright © 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tclOO.h" |
︙ | ︙ | |||
134 135 136 137 138 139 140 | * AIX), this code doesn't even compile without using * stubs, but on UNIX ELF systems, the problem is * less visible. */ tclOOStubsPtr = &stubsCopy; | | | 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | * AIX), this code doesn't even compile without using * stubs, but on UNIX ELF systems, the problem is * less visible. */ tclOOStubsPtr = &stubsCopy; code = Tcl_PkgProvide(interp, "pkgooa", "1.0"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL); return TCL_OK; } |
Changes to unix/dltest/pkgua.c.
1 2 3 4 5 6 | /* * pkgua.c -- * * This file contains a simple Tcl package "pkgua" that is intended for * testing the Tcl dynamic unloading facilities. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * pkgua.c -- * * This file contains a simple Tcl package "pkgua" that is intended for * testing the Tcl dynamic unloading facilities. * * Copyright © 1995 Sun Microsystems, Inc. * Copyright © 2004 Georgios Petasis * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" |
︙ | ︙ | |||
209 210 211 212 213 214 215 | /* * Initialise our Hash table, where we store the registered command tokens * for each interpreter. */ PkguaInitTokensHashTable(); | | | 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | /* * Initialise 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); |
︙ | ︙ |
Added unix/dltest/pkgπ.c.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 | /* * pkgπ.c -- * * This file contains a simple Tcl package "pkgπ" that is intended for * testing the Tcl dynamic loading facilities. * * Copyright © 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" /* * Prototypes for procedures defined later in this file: */ static int Pkg\u03C0_\u03A0ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- * * Pkga_EqObjCmd -- * * This procedure is invoked to process the "pkga_eq" Tcl command. It * expects two arguments and returns 1 if they are the same, 0 if they * are different. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int Pkg\u03C0_\u03A0ObjCmd( void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; const char *str1, *str2; int len1, len2; (void)dummy; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(3.14159)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgπ_Init -- * * This is a package initialization procedure, which is called by Tcl * when this package is to be added to an interpreter. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ DLLEXPORT int Pkg\u03C0_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } code = Tcl_PkgProvide(interp, "pkgπ", "1.0"); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "π", Pkg\u03C0_\u03A0ObjCmd, NULL, NULL); return TCL_OK; } |
Changes to unix/installManPage.
︙ | ︙ | |||
128 129 130 131 132 133 134 | if test -z "$First" ; then First=$Target sed -e "/man\.macros/r $SrcDir/man.macros" -e "/man\.macros/d" \ $ManPage > "$Dir/$First" chmod 644 "$Dir/$First" $Gzip "$Dir/$First" else | | | 128 129 130 131 132 133 134 135 136 137 138 139 140 | if test -z "$First" ; then First=$Target sed -e "/man\.macros/r $SrcDir/man.macros" -e "/man\.macros/d" \ $ManPage > "$Dir/$First" chmod 644 "$Dir/$First" $Gzip "$Dir/$First" else ln $SymOrLoc"$First$Gz" "$Dir/$Target$Gz" fi done ######################################################################## exit 0 |
Changes to unix/tcl.m4.
︙ | ︙ | |||
24 25 26 27 28 29 30 | # the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then # we reset no_tcl in case something fails here no_tcl=true AC_ARG_WITH(tcl, | | | | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | # the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then # we reset no_tcl in case something fails here no_tcl=true AC_ARG_WITH(tcl, AS_HELP_STRING([--with-tcl], [directory containing tcl configuration (tclConfig.sh)]), [with_tclconfig="${withval}"]) AC_MSG_CHECKING([for Tcl configuration]) AC_CACHE_VAL(ac_cv_c_tclconfig,[ # First check to see if --with-tcl was specified. if test x"${with_tclconfig}" != x ; then case "${with_tclconfig}" in */tclConfig.sh ) |
︙ | ︙ | |||
157 158 159 160 161 162 163 | # the alternative search directory is invoked by --with-tk # if test x"${no_tk}" = x ; then # we reset no_tk in case something fails here no_tk=true AC_ARG_WITH(tk, | | | | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 | # the alternative search directory is invoked by --with-tk # if test x"${no_tk}" = x ; then # we reset no_tk in case something fails here no_tk=true AC_ARG_WITH(tk, AS_HELP_STRING([--with-tk], [directory containing tk configuration (tkConfig.sh)]), [with_tkconfig="${withval}"]) AC_MSG_CHECKING([for Tk configuration]) AC_CACHE_VAL(ac_cv_c_tkconfig,[ # First check to see if --with-tkconfig was specified. if test x"${with_tkconfig}" != x ; then case "${with_tkconfig}" in */tkConfig.sh ) |
︙ | ︙ | |||
504 505 506 507 508 509 510 | # Sets the following vars: # SHARED_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, | | < < < < < < < < | 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 | # Sets the following vars: # SHARED_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, AS_HELP_STRING([--enable-shared], [build and link with shared libraries (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes" ; then AC_MSG_RESULT([shared]) SHARED_BUILD=1 else AC_MSG_RESULT([static]) SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) |
︙ | ︙ | |||
547 548 549 550 551 552 553 | # FRAMEWORK_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_FRAMEWORK], [ if test "`uname -s`" = "Darwin" ; then AC_MSG_CHECKING([how to package libraries]) AC_ARG_ENABLE(framework, | | | 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 | # FRAMEWORK_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_FRAMEWORK], [ if test "`uname -s`" = "Darwin" ; then AC_MSG_CHECKING([how to package libraries]) AC_ARG_ENABLE(framework, AS_HELP_STRING([--enable-framework], [package shared libraries in MacOSX frameworks (default: off)]), [enable_framework=$enableval], [enable_framework=no]) if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then AC_MSG_WARN([Frameworks can only be built if --enable-shared is yes]) enable_framework=no fi |
︙ | ︙ | |||
605 606 607 608 609 610 611 | # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, | | | 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 | # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, AS_HELP_STRING([--enable-symbols], [build with debugging symbols (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?]) |
︙ | ︙ | |||
664 665 666 667 668 669 670 | # # Defines the following vars: # HAVE_LANGINFO Triggers use of nl_langinfo if defined. #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_LANGINFO], [ AC_ARG_ENABLE(langinfo, | | | | | 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 | # # Defines the following vars: # HAVE_LANGINFO Triggers use of nl_langinfo if defined. #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_LANGINFO], [ AC_ARG_ENABLE(langinfo, AS_HELP_STRING([--enable-langinfo], [use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on)]), [langinfo_ok=$enableval], [langinfo_ok=yes]) HAVE_LANGINFO=0 if test "$langinfo_ok" = "yes"; then AC_CHECK_HEADER(langinfo.h,[langinfo_ok=yes],[langinfo_ok=no]) fi AC_MSG_CHECKING([whether to use nl_langinfo]) if test "$langinfo_ok" = "yes"; then AC_CACHE_VAL(tcl_cv_langinfo_h, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <langinfo.h>]], [[nl_langinfo(CODESET);]])], [tcl_cv_langinfo_h=yes], [tcl_cv_langinfo_h=no])]) AC_MSG_RESULT([$tcl_cv_langinfo_h]) if test $tcl_cv_langinfo_h = yes; then AC_DEFINE(HAVE_LANGINFO, 1, [Do we have nl_langinfo()?]) fi else AC_MSG_RESULT([$langinfo_ok]) fi |
︙ | ︙ | |||
716 717 718 719 720 721 722 | # according to the user's selection. # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_MANPAGES], [ AC_MSG_CHECKING([whether to use symlinks for manpages]) AC_ARG_ENABLE(man-symlinks, | | | | | | | | > | 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 | # according to the user's selection. # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_MANPAGES], [ AC_MSG_CHECKING([whether to use symlinks for manpages]) AC_ARG_ENABLE(man-symlinks, AS_HELP_STRING([--enable-man-symlinks], [use symlinks for the manpages (default: off)]), [test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks"], [enableval="no"]) AC_MSG_RESULT([$enableval]) AC_MSG_CHECKING([whether to compress the manpages]) AC_ARG_ENABLE(man-compression, AS_HELP_STRING([--enable-man-compression=PROG], [compress the manpages with PROG (default: off)]), [case $enableval in yes) AC_MSG_ERROR([missing argument to --enable-man-compression]);; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac], [enableval="no"]) AC_MSG_RESULT([$enableval]) if test "$enableval" != "no"; then AC_MSG_CHECKING([for compressed file suffix]) touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" AC_MSG_RESULT([$Z]) fi AC_MSG_CHECKING([whether to add a package name suffix for the manpages]) AC_ARG_ENABLE(man-suffix, AS_HELP_STRING([--enable-man-suffix=STRING], [use STRING as a suffix to manpage file names (default: no, AC_PACKAGE_NAME if enabled without specifying STRING)]), [case $enableval in yes) enableval="AC_PACKAGE_NAME" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac], [enableval="no"]) AC_MSG_RESULT([$enableval]) AC_SUBST(MAN_FLAGS) ]) #-------------------------------------------------------------------- # SC_CONFIG_SYSTEM # # Determine what the system is (some things cannot be easily checked # on a feature-driven basis, alas). This can usually be done via the # "uname" command. # # Arguments: # none # # Results: # Defines the following var: # # system - System/platform/version identification code. # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_SYSTEM], [ AC_CACHE_CHECK([system version], tcl_cv_sys_version, [ if test "${TEA_PLATFORM}" = "windows" ; then tcl_cv_sys_version=windows else |
︙ | ︙ | |||
888 889 890 891 892 893 894 | AC_DEFUN([SC_CONFIG_CFLAGS], [ # Step 0.a: Enable 64 bit support? AC_MSG_CHECKING([if 64bit support is requested]) AC_ARG_ENABLE(64bit, | | | | > | | | | 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 | AC_DEFUN([SC_CONFIG_CFLAGS], [ # Step 0.a: Enable 64 bit support? AC_MSG_CHECKING([if 64bit support is requested]) AC_ARG_ENABLE(64bit, AS_HELP_STRING([--enable-64bit], [enable 64bit support (default: off)]), [do64bit=$enableval], [do64bit=no]) AC_MSG_RESULT([$do64bit]) # Step 0.b: Enable Solaris 64 bit VIS support? AC_MSG_CHECKING([if 64bit Sparc VIS support is requested]) AC_ARG_ENABLE(64bit-vis, AS_HELP_STRING([--enable-64bit-vis], [enable 64bit Sparc VIS support (default: off)]), [do64bitVIS=$enableval], [do64bitVIS=no]) AC_MSG_RESULT([$do64bitVIS]) # Force 64bit on with VIS AS_IF([test "$do64bitVIS" = "yes"], [do64bit=yes]) # Step 0.c: Check if visibility support is available. Do this here so # that platform specific alternatives can be used below if this fails. AC_CACHE_CHECK([if compiler supports visibility "hidden"], tcl_cv_cc_visibility_hidden, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_LINK_IFELSE([AC_LANG_PROGRAM([[ extern __attribute__((__visibility__("hidden"))) void f(void); void f(void) {}]], [[f();]])], [tcl_cv_cc_visibility_hidden=yes], [tcl_cv_cc_visibility_hidden=no]) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ AC_DEFINE(MODULE_SCOPE, [extern __attribute__((__visibility__("hidden")))], [Compiler support for module scope symbols]) AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols]) ]) # Step 0.d: Disable -rpath support? AC_MSG_CHECKING([if rpath support is requested]) AC_ARG_ENABLE(rpath, AS_HELP_STRING([--disable-rpath], [disable rpath support (default: on)]), [doRpath=$enableval], [doRpath=yes]) AC_MSG_RESULT([$doRpath]) # Step 1: set the variable "system" to hold the name and version number # for the system. |
︙ | ︙ | |||
967 968 969 970 971 972 973 | AS_IF([test "$GCC" = yes], [ CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith" case "${CC}" in *++|*++-*) ;; *) | | | 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 | AS_IF([test "$GCC" = yes], [ CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith" case "${CC}" in *++|*++-*) ;; *) CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -fextended-identifiers" ;; esac ], [ CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="" ]) |
︙ | ︙ | |||
1079 1080 1081 1082 1083 1084 1085 | SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; | | | | | | | 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 | SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32_*|MSYS_*) SHLIB_CFLAGS="-fno-common" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a" AC_CACHE_CHECK(for Cygwin version of gcc, ac_cv_cygwin, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef __CYGWIN__ #error cygwin #endif ]], [[]])], [ac_cv_cygwin=no], [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" |
︙ | ︙ | |||
1286 1287 1288 1289 1290 1291 1292 | 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" | | | 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 | 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 ]) ]) |
︙ | ︙ | |||
1401 1402 1403 1404 1405 1406 1407 | 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" | > | | > | | > | > | | | | | | | | | | | | 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 | 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`]);; esac ], [ # Check for combined 32-bit and 64-bit fat build AS_IF([echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '], [ fat_32_64=yes]) ]) SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' AC_CACHE_CHECK([if ld accepts -single_module flag], tcl_cv_ld_single_module, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])],[tcl_cv_ld_single_module=yes], [tcl_cv_ld_single_module=no]) LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_single_module = yes], [ SHLIB_LD="${SHLIB_LD} -Wl,-single_module" ]) SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" DL_LIBS="" LDFLAGS="$LDFLAGS -headerpad_max_install_names" AC_CACHE_CHECK([if ld accepts -search_paths_first flag], tcl_cv_ld_search_paths_first, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])], [tcl_cv_ld_search_paths_first=yes], [tcl_cv_ld_search_paths_first=no]) LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_search_paths_first = yes], [ LDFLAGS="$LDFLAGS -Wl,-search_paths_first" ]) AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ AC_DEFINE(MODULE_SCOPE, [__private_extern__], [Compiler support for module scope symbols]) tcl_cv_cc_visibility_hidden=yes ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?]) PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' AC_MSG_CHECKING([whether to use CoreFoundation]) AC_ARG_ENABLE(corefoundation, AS_HELP_STRING([--enable-corefoundation], [use CoreFoundation API on MacOSX (default: on)]), [tcl_corefoundation=$enableval], [tcl_corefoundation=yes]) AC_MSG_RESULT([$tcl_corefoundation]) AS_IF([test $tcl_corefoundation = yes], [ AC_CACHE_CHECK([for CoreFoundation.framework], tcl_cv_lib_corefoundation, [ hold_libs=$LIBS AS_IF([test "$fat_32_64" = yes], [ for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit # archs from CFLAGS et al. while testing for # presence of CF. 64-bit CF is disabled in # tclUnixPort.h if necessary. eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done]) LIBS="$LIBS -framework CoreFoundation" AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <CoreFoundation/CoreFoundation.h>]], [[CFBundleRef b = CFBundleGetMainBundle();]])], [tcl_cv_lib_corefoundation=yes], [tcl_cv_lib_corefoundation=no]) AS_IF([test "$fat_32_64" = yes], [ for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done]) LIBS=$hold_libs]) AS_IF([test $tcl_cv_lib_corefoundation = yes], [ LIBS="$LIBS -framework CoreFoundation" AC_DEFINE(HAVE_COREFOUNDATION, 1, [Do we have access to Darwin CoreFoundation.framework?]) ], [tcl_corefoundation=no]) AS_IF([test "$fat_32_64" = yes -a $tcl_corefoundation = yes],[ AC_CACHE_CHECK([for 64-bit CoreFoundation], tcl_cv_lib_corefoundation_64, [ for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <CoreFoundation/CoreFoundation.h>]], [[CFBundleRef b = CFBundleGetMainBundle();]])], [tcl_cv_lib_corefoundation_64=yes], [tcl_cv_lib_corefoundation_64=no]) for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done]) AS_IF([test $tcl_cv_lib_corefoundation_64 = no], [ AC_DEFINE(NO_COREFOUNDATION_64, 1, [Is Darwin CoreFoundation unavailable for 64-bit?]) LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" |
︙ | ︙ | |||
1725 1726 1727 1728 1729 1730 1731 | DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. AC_CACHE_CHECK([for ld accepts -Bexport flag], tcl_cv_ld_Bexport, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" | | | 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 | DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. AC_CACHE_CHECK([for ld accepts -Bexport flag], tcl_cv_ld_Bexport, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])],[tcl_cv_ld_Bexport=yes],[tcl_cv_ld_Bexport=no]) LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_Bexport = yes], [ LDFLAGS="$LDFLAGS -Wl,-Bexport" ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; |
︙ | ︙ | |||
1752 1753 1754 1755 1756 1757 1758 | dnl # both CPPFLAGS and CFLAGS (unlike our compile and link) but configure's dnl # preprocessing tests use only CPPFLAGS. AC_CONFIG_COMMANDS_PRE([CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS=""]) # Step 4: disable dynamic loading if requested via a command-line switch. AC_ARG_ENABLE(load, | | | 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 | dnl # both CPPFLAGS and CFLAGS (unlike our compile and link) but configure's dnl # preprocessing tests use only CPPFLAGS. AC_CONFIG_COMMANDS_PRE([CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS=""]) # Step 4: disable dynamic loading if requested via a command-line switch. AC_ARG_ENABLE(load, AS_HELP_STRING([--enable-load], [allow dynamic loading and "load" command (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) AS_IF([test "$tcl_ok" = no], [DL_OBJS=""]) AS_IF([test "x$DL_OBJS" != x], [BUILD_DLTEST="\$(DLTEST_TARGETS)"], [ AC_MSG_WARN([Can't figure out how to do dynamic loading or shared libraries on this system.]) SHLIB_CFLAGS="" |
︙ | ︙ | |||
1779 1780 1781 1782 1783 1784 1785 | # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [ case $system in AIX-*) ;; BSD/OS*) ;; | | | | 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 | # libraries to the right flags for gcc, instead of those for the # 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-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; OSF1-V*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac]) AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ AC_DEFINE(MODULE_SCOPE, [extern], |
︙ | ︙ | |||
1836 1837 1838 1839 1840 1841 1842 | # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. AS_IF([test "x${TCL_LIBS}" = x], [ TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"]) AC_SUBST(TCL_LIBS) | | | | | | | < | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > | 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 | # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. AS_IF([test "x${TCL_LIBS}" = x], [ TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"]) AC_SUBST(TCL_LIBS) # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. AC_CACHE_CHECK(for cast to union support, tcl_cv_cast_to_union, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[ union foo { int i; double d; }; union foo f = (union foo) (int) 0; ]])], [tcl_cv_cast_to_union=yes], [tcl_cv_cast_to_union=no]) ) if test "$tcl_cv_cast_to_union" = "yes"; then AC_DEFINE(HAVE_CAST_TO_UNION, 1, [Defined when compiler supports casting to union type.]) 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 if test "$ac_cv_nolto" = "yes" ; then CFLAGS_NOLTO="-fno-lto" else CFLAGS_NOLTO="" fi AC_CACHE_CHECK([if the compiler understands -finput-charset], tcl_cv_cc_input_charset, [ 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 CFLAGS="$CFLAGS -finput-charset=UTF-8" fi AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],) # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. AC_SUBST(DL_LIBS) AC_SUBST(DL_OBJS) AC_SUBST(PLAT_OBJS) AC_SUBST(PLAT_SRCS) AC_SUBST(LDAIX_SRC) AC_SUBST(CFLAGS) AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) AC_SUBST(CFLAGS_NOLTO) AC_SUBST(LDFLAGS) AC_SUBST(LDFLAGS_DEBUG) AC_SUBST(LDFLAGS_OPTIMIZE) AC_SUBST(CC_SEARCH_FLAGS) AC_SUBST(LD_SEARCH_FLAGS) |
︙ | ︙ | |||
1923 1924 1925 1926 1927 1928 1929 | # HAVE_SYS_PARAM_H # HAVE_STRING_H ? # #-------------------------------------------------------------------- AC_DEFUN([SC_MISSING_POSIX_HEADERS], [ AC_CACHE_CHECK([dirent.h], tcl_cv_dirent_h, [ | | | | | 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 | # HAVE_SYS_PARAM_H # HAVE_STRING_H ? # #-------------------------------------------------------------------- AC_DEFUN([SC_MISSING_POSIX_HEADERS], [ AC_CACHE_CHECK([dirent.h], tcl_cv_dirent_h, [ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h> #include <dirent.h>]], [[ #ifndef _POSIX_SOURCE # ifdef __Lynx__ /* * Generate compilation error to make the test fail: Lynx headers * are only valid if really in the POSIX environment. */ missing_procedure(); # endif #endif DIR *d; struct dirent *entryPtr; char *p; d = opendir("foobar"); entryPtr = readdir(d); p = entryPtr->d_name; closedir(d); ]])],[tcl_cv_dirent_h=yes],[tcl_cv_dirent_h=no])]) if test $tcl_cv_dirent_h = no; then AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?]) fi AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) |
︙ | ︙ | |||
1969 1970 1971 1972 1973 1974 1975 | AC_DEFINE(NO_STRING_H, 1, [Do we have <string.h>?]) fi AC_CHECK_HEADER(sys/wait.h, , [AC_DEFINE(NO_SYS_WAIT_H, 1, [Do we have <sys/wait.h>?])]) AC_CHECK_HEADER(dlfcn.h, , [AC_DEFINE(NO_DLFCN_H, 1, [Do we have <dlfcn.h>?])]) # OS/390 lacks sys/param.h (and doesn't need it, by chance). | | | 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 | AC_DEFINE(NO_STRING_H, 1, [Do we have <string.h>?]) fi AC_CHECK_HEADER(sys/wait.h, , [AC_DEFINE(NO_SYS_WAIT_H, 1, [Do we have <sys/wait.h>?])]) AC_CHECK_HEADER(dlfcn.h, , [AC_DEFINE(NO_DLFCN_H, 1, [Do we have <dlfcn.h>?])]) # OS/390 lacks sys/param.h (and doesn't need it, by chance). AC_CHECK_HEADERS([sys/param.h]) ]) #-------------------------------------------------------------------- # SC_PATH_X # # Locate the X11 header files and the X11 library archive. Try # the ac_path_x macro first, but if it doesn't find the X stuff |
︙ | ︙ | |||
1998 1999 2000 2001 2002 2003 2004 | #-------------------------------------------------------------------- AC_DEFUN([SC_PATH_X], [ AC_PATH_X not_really_there="" if test "$no_x" = ""; then if test "$x_includes" = ""; then | | | | 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 | #-------------------------------------------------------------------- AC_DEFUN([SC_PATH_X], [ AC_PATH_X not_really_there="" if test "$no_x" = ""; then if test "$x_includes" = ""; then AC_PREPROC_IFELSE([AC_LANG_SOURCE([[#include <X11/Xlib.h>]])],[],[not_really_there="yes"]) else if test ! -r $x_includes/X11/Xlib.h; then not_really_there="yes" fi fi fi if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then AC_MSG_CHECKING([for X11 header files]) found_xincludes="no" AC_PREPROC_IFELSE([AC_LANG_SOURCE([[#include <X11/Xlib.h>]])],[found_xincludes="yes"],[found_xincludes="no"]) if test "$found_xincludes" = "no"; then dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include" for i in $dirs ; do if test -r $i/X11/Xlib.h; then AC_MSG_RESULT([$i]) XINCLUDES=" -I$i" found_xincludes="yes" |
︙ | ︙ | |||
2116 2117 2118 2119 2120 2121 2122 | # HAVE_TM_TZADJ # HAVE_TIMEZONE_VAR # #-------------------------------------------------------------------- AC_DEFUN([SC_TIME_HANDLER], [ AC_CHECK_HEADERS(sys/time.h) | | | | > | | > | | | | | | | | | > | | 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 | # HAVE_TM_TZADJ # HAVE_TIMEZONE_VAR # #-------------------------------------------------------------------- AC_DEFUN([SC_TIME_HANDLER], [ AC_CHECK_HEADERS(sys/time.h) AC_CHECK_HEADERS_ONCE([sys/time.h]) AC_CHECK_FUNCS(gmtime_r localtime_r mktime) AC_CACHE_CHECK([tm_tzadj in struct tm], tcl_cv_member_tm_tzadj, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>]], [[struct tm tm; (void)tm.tm_tzadj;]])], [tcl_cv_member_tm_tzadj=yes], [tcl_cv_member_tm_tzadj=no])]) if test $tcl_cv_member_tm_tzadj = yes ; then AC_DEFINE(HAVE_TM_TZADJ, 1, [Should we use the tm_tzadj field of struct tm?]) fi AC_CACHE_CHECK([tm_gmtoff in struct tm], tcl_cv_member_tm_gmtoff, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>]], [[struct tm tm; (void)tm.tm_gmtoff;]])], [tcl_cv_member_tm_gmtoff=yes], [tcl_cv_member_tm_gmtoff=no])]) if test $tcl_cv_member_tm_gmtoff = yes ; then AC_DEFINE(HAVE_TM_GMTOFF, 1, [Should we use the tm_gmtoff field of struct tm?]) 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>]], [[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>]], [[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 fi ]) #-------------------------------------------------------------------- # SC_TCL_LINK_LIBS # # Search for the libraries needed to link the Tcl shell. # Things like the math library (-lm), socket stuff (-lsocket vs. # -lnsl), zlib (-lz) and libtommath (-ltommath) or thread library # (-lpthread) are dealt with here. # # Arguments: # None. # # Results: # # Sets the following vars: |
︙ | ︙ | |||
2309 2310 2311 2312 2313 2314 2315 | # _LARGEFILE64_SOURCE # _LARGEFILE_SOURCE64 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_EARLY_FLAG],[ AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]), | > | < | | | | 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 | # _LARGEFILE64_SOURCE # _LARGEFILE_SOURCE64 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_EARLY_FLAG],[ AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]), AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[$2]], [[$3]])], [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[[#define ]$1[ 1 ]$2]], [[$3]])], [tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no)])) if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then AC_DEFINE($1, 1, [Add the ]$1[ flag when building]) tcl_flags="$tcl_flags $1" fi ]) AC_DEFUN([SC_TCL_EARLY_FLAGS],[ |
︙ | ︙ | |||
2348 2349 2350 2351 2352 2353 2354 | # Arguments: # None # # Results: # # Might define the following vars: # TCL_WIDE_INT_IS_LONG | < < < < | | | < < < < | | | | | | | | | | | | | | 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 | # Arguments: # None # # Results: # # Might define the following vars: # TCL_WIDE_INT_IS_LONG # HAVE_STRUCT_DIRENT64, HAVE_DIR64 # HAVE_STRUCT_STAT64 # HAVE_TYPE_OFF64_T # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_64BIT_FLAGS], [ AC_MSG_CHECKING([for 64-bit integer type]) AC_CACHE_VAL(tcl_cv_type_64bit,[ tcl_cv_type_64bit=none # See if we could use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[switch (0) { case 1: case (sizeof(long long)==sizeof(long)): ; }]])],[tcl_cv_type_64bit="long long"],[])]) if test "${tcl_cv_type_64bit}" = none ; then AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Do 'long' and 'long long' have the same size (64-bit)?]) AC_MSG_RESULT([yes]) else # Now check for auxiliary declarations AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h> #include <dirent.h>]], [[struct dirent64 p;]])], [tcl_cv_struct_dirent64=yes],[tcl_cv_struct_dirent64=no])]) if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in <sys/types.h>?]) fi AC_CACHE_CHECK([for DIR64], tcl_cv_DIR64,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h> #include <dirent.h>]], [[struct dirent64 *p; DIR64 d = opendir64("."); p = readdir64(d); rewinddir64(d); closedir64(d);]])], [tcl_cv_DIR64=yes], [tcl_cv_DIR64=no])]) if test "x${tcl_cv_DIR64}" = "xyes" ; then AC_DEFINE(HAVE_DIR64, 1, [Is 'DIR64' in <sys/types.h>?]) fi AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/stat.h>]], [[struct stat64 p; ]])], [tcl_cv_struct_stat64=yes], [tcl_cv_struct_stat64=no])]) if test "x${tcl_cv_struct_stat64}" = "xyes" ; then AC_DEFINE(HAVE_STRUCT_STAT64, 1, [Is 'struct stat64' in <sys/stat.h>?]) fi AC_CHECK_FUNCS(open64 lseek64) AC_MSG_CHECKING([for off64_t]) AC_CACHE_VAL(tcl_cv_type_off64_t,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>]], [[off64_t offset; ]])], [tcl_cv_type_off64_t=yes], [tcl_cv_type_off64_t=no])]) dnl Define HAVE_TYPE_OFF64_T only when the off64_t type and the dnl functions lseek64 and open64 are defined. if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then AC_DEFINE(HAVE_TYPE_OFF64_T, 1, [Is off64_t in <sys/types.h>?]) AC_MSG_RESULT([yes]) |
︙ | ︙ | |||
2440 2441 2442 2443 2444 2445 2446 | # Will define the following vars: # TCL_CFGVAL_ENCODING # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CFG_ENCODING], [ AC_ARG_WITH(encoding, | | | | 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 | # Will define the following vars: # TCL_CFGVAL_ENCODING # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CFG_ENCODING], [ AC_ARG_WITH(encoding, AS_HELP_STRING([--with-encoding], [encoding for configuration values (default: utf-8)]), [with_tcencoding=${withval}]) if test x"${with_tcencoding}" != x ; then AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}", [What encoding should be used for embedded configuration info?]) else AC_DEFINE(TCL_CFGVAL_ENCODING,"utf-8", [What encoding should be used for embedded configuration info?]) |
︙ | ︙ | |||
2473 2474 2475 2476 2477 2478 2479 | # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CHECK_BROKEN_FUNC],[ AC_CHECK_FUNC($1, tcl_ok=1, tcl_ok=0) if test ["$tcl_ok"] = 1; then AC_CACHE_CHECK([proper ]$1[ implementation], [tcl_cv_]$1[_unbroken], | | | | | 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 | # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CHECK_BROKEN_FUNC],[ AC_CHECK_FUNC($1, tcl_ok=1, tcl_ok=0) if test ["$tcl_ok"] = 1; then AC_CACHE_CHECK([proper ]$1[ implementation], [tcl_cv_]$1[_unbroken], AC_RUN_IFELSE([AC_LANG_SOURCE([[[ #include <stdlib.h> #include <string.h> int main() {]$2[}]]])],[tcl_cv_$1_unbroken=ok], [tcl_cv_$1_unbroken=broken],[tcl_cv_$1_unbroken=unknown])) if test ["$tcl_cv_]$1[_unbroken"] = "ok"; then tcl_ok=1 else tcl_ok=0 fi fi if test ["$tcl_ok"] = 0; then |
︙ | ︙ | |||
2522 2523 2524 2525 2526 2527 2528 | AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_DECL], [AC_CHECK_DECLS(gethostbyaddr_r, [ tcl_cv_api_gethostbyaddr_r=yes],[tcl_cv_api_gethostbyaddr_r=no],[#include <netdb.h>]) ]) AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_TYPE], [AC_CHECK_FUNC(gethostbyaddr_r, [ AC_CACHE_CHECK([for gethostbyaddr_r with 7 args], tcl_cv_api_gethostbyaddr_r_7, [ | | | | | | | | 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 | AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_DECL], [AC_CHECK_DECLS(gethostbyaddr_r, [ tcl_cv_api_gethostbyaddr_r=yes],[tcl_cv_api_gethostbyaddr_r=no],[#include <netdb.h>]) ]) AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_TYPE], [AC_CHECK_FUNC(gethostbyaddr_r, [ AC_CACHE_CHECK([for gethostbyaddr_r with 7 args], tcl_cv_api_gethostbyaddr_r_7, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <netdb.h> ]], [[ char *addr; int length; int type; struct hostent *result; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &h_errnop); ]])],[tcl_cv_api_gethostbyaddr_r_7=yes],[tcl_cv_api_gethostbyaddr_r_7=no])]) tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R_7, 1, [Define to 1 if gethostbyaddr_r takes 7 args.]) else AC_CACHE_CHECK([for gethostbyaddr_r with 8 args], tcl_cv_api_gethostbyaddr_r_8, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <netdb.h> ]], [[ char *addr; int length; int type; struct hostent *result, *resultp; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &resultp, &h_errnop); ]])],[tcl_cv_api_gethostbyaddr_r_8=yes],[tcl_cv_api_gethostbyaddr_r_8=no])]) tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R_8, 1, [Define to 1 if gethostbyaddr_r takes 8 args.]) fi fi if test "$tcl_ok" = yes; then |
︙ | ︙ | |||
2603 2604 2605 2606 2607 2608 2609 | AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_DECL], [AC_CHECK_DECLS(gethostbyname_r, [ tcl_cv_api_gethostbyname_r=yes],[tcl_cv_api_gethostbyname_r=no],[#include <netdb.h>]) ]) AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_TYPE], [AC_CHECK_FUNC(gethostbyname_r, [ AC_CACHE_CHECK([for gethostbyname_r with 6 args], tcl_cv_api_gethostbyname_r_6, [ | | | | | | | | | | | 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 | AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_DECL], [AC_CHECK_DECLS(gethostbyname_r, [ tcl_cv_api_gethostbyname_r=yes],[tcl_cv_api_gethostbyname_r=no],[#include <netdb.h>]) ]) AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_TYPE], [AC_CHECK_FUNC(gethostbyname_r, [ AC_CACHE_CHECK([for gethostbyname_r with 6 args], tcl_cv_api_gethostbyname_r_6, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <netdb.h> ]], [[ char *name; struct hostent *he, *res; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); ]])],[tcl_cv_api_gethostbyname_r_6=yes],[tcl_cv_api_gethostbyname_r_6=no])]) tcl_ok=$tcl_cv_api_gethostbyname_r_6 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_6, 1, [Define to 1 if gethostbyname_r takes 6 args.]) else AC_CACHE_CHECK([for gethostbyname_r with 5 args], tcl_cv_api_gethostbyname_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <netdb.h> ]], [[ char *name; struct hostent *he; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); ]])],[tcl_cv_api_gethostbyname_r_5=yes],[tcl_cv_api_gethostbyname_r_5=no])]) tcl_ok=$tcl_cv_api_gethostbyname_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_5, 1, [Define to 1 if gethostbyname_r takes 5 args.]) else AC_CACHE_CHECK([for gethostbyname_r with 3 args], tcl_cv_api_gethostbyname_r_3, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <netdb.h> ]], [[ char *name; struct hostent *he; struct hostent_data data; (void) gethostbyname_r(name, he, &data); ]])],[tcl_cv_api_gethostbyname_r_3=yes],[tcl_cv_api_gethostbyname_r_3=no])]) tcl_ok=$tcl_cv_api_gethostbyname_r_3 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_3, 1, [Define to 1 if gethostbyname_r takes 3 args.]) fi fi fi |
︙ | ︙ | |||
2679 2680 2681 2682 2683 2684 2685 | # HAVE_GETPWUID_R_4 # HAVE_GETPWUID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWUID_R], [AC_CHECK_FUNC(getpwuid_r, [ AC_CACHE_CHECK([for getpwuid_r with 5 args], tcl_cv_api_getpwuid_r_5, [ | | | | | | | | 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 | # HAVE_GETPWUID_R_4 # HAVE_GETPWUID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWUID_R], [AC_CHECK_FUNC(getpwuid_r, [ AC_CACHE_CHECK([for getpwuid_r with 5 args], tcl_cv_api_getpwuid_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> #include <pwd.h> ]], [[ uid_t uid; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); ]])],[tcl_cv_api_getpwuid_r_5=yes],[tcl_cv_api_getpwuid_r_5=no])]) tcl_ok=$tcl_cv_api_getpwuid_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R_5, 1, [Define to 1 if getpwuid_r takes 5 args.]) else AC_CACHE_CHECK([for getpwuid_r with 4 args], tcl_cv_api_getpwuid_r_4, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> #include <pwd.h> ]], [[ uid_t uid; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(uid, &pw, buf, buflen); ]])],[tcl_cv_api_getpwuid_r_4=yes],[tcl_cv_api_getpwuid_r_4=no])]) tcl_ok=$tcl_cv_api_getpwuid_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R_4, 1, [Define to 1 if getpwuid_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then |
︙ | ︙ | |||
2739 2740 2741 2742 2743 2744 2745 | # HAVE_GETPWNAM_R_4 # HAVE_GETPWNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWNAM_R], [AC_CHECK_FUNC(getpwnam_r, [ AC_CACHE_CHECK([for getpwnam_r with 5 args], tcl_cv_api_getpwnam_r_5, [ | | | | | | | | 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 | # HAVE_GETPWNAM_R_4 # HAVE_GETPWNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWNAM_R], [AC_CHECK_FUNC(getpwnam_r, [ AC_CACHE_CHECK([for getpwnam_r with 5 args], tcl_cv_api_getpwnam_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> #include <pwd.h> ]], [[ char *name; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwnam_r(name, &pw, buf, buflen, &pwp); ]])],[tcl_cv_api_getpwnam_r_5=yes],[tcl_cv_api_getpwnam_r_5=no])]) tcl_ok=$tcl_cv_api_getpwnam_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R_5, 1, [Define to 1 if getpwnam_r takes 5 args.]) else AC_CACHE_CHECK([for getpwnam_r with 4 args], tcl_cv_api_getpwnam_r_4, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> #include <pwd.h> ]], [[ char *name; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(name, &pw, buf, buflen); ]])],[tcl_cv_api_getpwnam_r_4=yes],[tcl_cv_api_getpwnam_r_4=no])]) tcl_ok=$tcl_cv_api_getpwnam_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R_4, 1, [Define to 1 if getpwnam_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then |
︙ | ︙ | |||
2799 2800 2801 2802 2803 2804 2805 | # HAVE_GETGRGID_R_4 # HAVE_GETGRGID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRGID_R], [AC_CHECK_FUNC(getgrgid_r, [ AC_CACHE_CHECK([for getgrgid_r with 5 args], tcl_cv_api_getgrgid_r_5, [ | | | | | | | | 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 | # HAVE_GETGRGID_R_4 # HAVE_GETGRGID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRGID_R], [AC_CHECK_FUNC(getgrgid_r, [ AC_CACHE_CHECK([for getgrgid_r with 5 args], tcl_cv_api_getgrgid_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> #include <grp.h> ]], [[ gid_t gid; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrgid_r(gid, &gr, buf, buflen, &grp); ]])],[tcl_cv_api_getgrgid_r_5=yes],[tcl_cv_api_getgrgid_r_5=no])]) tcl_ok=$tcl_cv_api_getgrgid_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R_5, 1, [Define to 1 if getgrgid_r takes 5 args.]) else AC_CACHE_CHECK([for getgrgid_r with 4 args], tcl_cv_api_getgrgid_r_4, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> #include <grp.h> ]], [[ gid_t gid; struct group gr; char buf[512]; int buflen = 512; (void)getgrgid_r(gid, &gr, buf, buflen); ]])],[tcl_cv_api_getgrgid_r_4=yes],[tcl_cv_api_getgrgid_r_4=no])]) tcl_ok=$tcl_cv_api_getgrgid_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R_4, 1, [Define to 1 if getgrgid_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then |
︙ | ︙ | |||
2859 2860 2861 2862 2863 2864 2865 | # HAVE_GETGRNAM_R_4 # HAVE_GETGRNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRNAM_R], [AC_CHECK_FUNC(getgrnam_r, [ AC_CACHE_CHECK([for getgrnam_r with 5 args], tcl_cv_api_getgrnam_r_5, [ | | | | | | | | 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 | # HAVE_GETGRNAM_R_4 # HAVE_GETGRNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRNAM_R], [AC_CHECK_FUNC(getgrnam_r, [ AC_CACHE_CHECK([for getgrnam_r with 5 args], tcl_cv_api_getgrnam_r_5, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> #include <grp.h> ]], [[ char *name; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrnam_r(name, &gr, buf, buflen, &grp); ]])],[tcl_cv_api_getgrnam_r_5=yes],[tcl_cv_api_getgrnam_r_5=no])]) tcl_ok=$tcl_cv_api_getgrnam_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R_5, 1, [Define to 1 if getgrnam_r takes 5 args.]) else AC_CACHE_CHECK([for getgrnam_r with 4 args], tcl_cv_api_getgrnam_r_4, [ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> #include <grp.h> ]], [[ char *name; struct group gr; char buf[512]; int buflen = 512; (void)getgrnam_r(name, &gr, buf, buflen); ]])],[tcl_cv_api_getgrnam_r_4=yes],[tcl_cv_api_getgrnam_r_4=no])]) tcl_ok=$tcl_cv_api_getgrnam_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R_4, 1, [Define to 1 if getgrnam_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then |
︙ | ︙ | |||
2993 2994 2995 2996 2997 2998 2999 | # Locate a zip encoder installed on the system path, or none. # # Arguments: # none # # Results: # Substitutes the following vars: | > | > > > > > > > > > > > > > > > > > > > > > | 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 | # Locate a zip encoder installed on the system path, or none. # # Arguments: # none # # Results: # Substitutes the following vars: # MACHER_PROG # ZIP_PROG # ZIP_PROG_OPTIONS # ZIP_PROG_VFSSEARCH # ZIP_INSTALL_OBJS #------------------------------------------------------------------------ AC_DEFUN([SC_ZIPFS_SUPPORT], [ MACHER_PROG="" ZIP_PROG="" ZIP_PROG_OPTIONS="" ZIP_PROG_VFSSEARCH="" ZIP_INSTALL_OBJS="" AC_MSG_CHECKING([for macher]) AC_CACHE_VAL(ac_cv_path_macher, [ search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/macher 2> /dev/null` \ `ls -r $dir/macher 2> /dev/null` ; do if test x"$ac_cv_path_macher" = x ; then if test -f "$j" ; then ac_cv_path_macher=$j break fi fi done done ]) if test -f "$ac_cv_path_macher" ; then MACHER_PROG="$ac_cv_path_macher" AC_MSG_RESULT([$MACHER_PROG]) AC_MSG_RESULT([Found macher in environment]) fi AC_MSG_CHECKING([for zip]) AC_CACHE_VAL(ac_cv_path_zip, [ search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/zip 2> /dev/null` \ `ls -r $dir/zip 2> /dev/null` ; do if test x"$ac_cv_path_zip" = x ; then |
︙ | ︙ | |||
3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 | # We can use the locally distributed minizip instead ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}" ZIP_PROG_OPTIONS="-o -r" ZIP_PROG_VFSSEARCH="*" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" AC_MSG_RESULT([No zip found on PATH. Building minizip]) fi AC_SUBST(ZIP_PROG) AC_SUBST(ZIP_PROG_OPTIONS) AC_SUBST(ZIP_PROG_VFSSEARCH) AC_SUBST(ZIP_INSTALL_OBJS) ]) # Local Variables: # mode: autoconf # End: | > | 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 | # We can use the locally distributed minizip instead ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}" ZIP_PROG_OPTIONS="-o -r" ZIP_PROG_VFSSEARCH="*" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" AC_MSG_RESULT([No zip found on PATH. Building minizip]) fi AC_SUBST(MACHER_PROG) AC_SUBST(ZIP_PROG) AC_SUBST(ZIP_PROG_OPTIONS) AC_SUBST(ZIP_PROG_VFSSEARCH) AC_SUBST(ZIP_INSTALL_OBJS) ]) # Local Variables: # mode: autoconf # End: |
Changes to unix/tcl.pc.in.
1 2 3 4 5 6 7 | # tcl pkg-config source file prefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@ libfile=@TCL_LIB_FILE@ | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # 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: http://www.tcl.tk/ 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@ |
︙ | ︙ |
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 | # 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: 9.0a2 Release: 2 License: BSD Group: Development/Languages Source: http://prdownloads.sourceforge.net/tcl/tcl%{version}-src.tar.gz URL: http://www.tcl.tk/ Buildroot: /var/tmp/%{name}%{version} |
︙ | ︙ |
Changes to unix/tclAppInit.c.
︙ | ︙ | |||
8 9 10 11 12 13 14 | * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ | < < > > > > | | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" #if TCL_MAJOR_VERSION < 9 && 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); | | > | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | { #ifdef TCL_XT_TEST XtToolkitInitialize(); #endif #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #elif !defined(_WIN32) || defined(UNICODE) /* 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; } | | | 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 | } #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) { |
︙ | ︙ | |||
148 149 150 151 152 153 154 | * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no * user-specific startup file will be run under any conditions. */ #ifdef DJGPP | | | | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no * user-specific startup file will be run under any conditions. */ #ifdef DJGPP Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY); #else Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY); #endif return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to unix/tclConfig.h.in.
︙ | ︙ | |||
135 136 137 138 139 140 141 | /* Define to 1 if you have the `gmtime_r' function. */ #undef HAVE_GMTIME_R /* Compiler support for module scope symbols */ #undef HAVE_HIDDEN | | < < < | 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 | /* Define to 1 if you have the `gmtime_r' function. */ #undef HAVE_GMTIME_R /* Compiler support for module scope symbols */ #undef HAVE_HIDDEN /* Define to 1 if the system has the type `intptr_t'. */ #undef HAVE_INTPTR_T /* Define to 1 if you have the <inttypes.h> header file. */ #undef HAVE_INTTYPES_H /* Do we have nl_langinfo()? */ #undef HAVE_LANGINFO /* Define to 1 if you have the <libkern/OSAtomic.h> header file. */ #undef HAVE_LIBKERN_OSATOMIC_H /* Define to 1 if you have the `localtime_r' function. */ #undef HAVE_LOCALTIME_R /* Define to 1 if you have the `lseek64' function. */ #undef HAVE_LSEEK64 /* Define to 1 if you have the `mkstemp' function. */ #undef HAVE_MKSTEMP /* Define to 1 if you have the `mkstemps' function. */ #undef HAVE_MKSTEMPS /* Define to 1 if you have the `mktime' function. */ |
︙ | ︙ | |||
200 201 202 203 204 205 206 207 208 209 210 211 212 213 | #undef HAVE_SIGNED_CHAR /* Do we have <stdbool.h>? */ #undef HAVE_STDBOOL_H /* Define to 1 if you have the <stdint.h> header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the <stdlib.h> header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the <strings.h> header file. */ #undef HAVE_STRINGS_H | > > > | 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 | #undef HAVE_SIGNED_CHAR /* Do we have <stdbool.h>? */ #undef HAVE_STDBOOL_H /* Define to 1 if you have the <stdint.h> header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the <stdio.h> header file. */ #undef HAVE_STDIO_H /* Define to 1 if you have the <stdlib.h> header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the <strings.h> header file. */ #undef HAVE_STRINGS_H |
︙ | ︙ | |||
285 286 287 288 289 290 291 | /* Should we use the tm_tzadj field of struct tm? */ #undef HAVE_TM_TZADJ /* Is off64_t in <sys/types.h>? */ #undef HAVE_TYPE_OFF64_T | | | 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 | /* Should we use the tm_tzadj field of struct tm? */ #undef HAVE_TM_TZADJ /* Is off64_t in <sys/types.h>? */ #undef HAVE_TYPE_OFF64_T /* Define to 1 if the system has the type `uintptr_t'. */ #undef HAVE_UINTPTR_T /* Define to 1 if you have the <unistd.h> header file. */ #undef HAVE_UNISTD_H /* Define to 1 if you have the `waitpid' function. */ #undef HAVE_WAITPID |
︙ | ︙ | |||
393 394 395 396 397 398 399 | /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Is this a static build? */ #undef STATIC_BUILD | | > > | 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 | /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Is this a static build? */ #undef STATIC_BUILD /* Define to 1 if all of the C90 standard headers exist (not just the ones required in a freestanding environment). This macro is provided for backward compatibility; new code need not use it. */ #undef STDC_HEADERS /* What encoding should be used for embedded configuration info? */ #undef TCL_CFGVAL_ENCODING /* Is this a 64-bit build? */ #undef TCL_CFG_DO64BIT |
︙ | ︙ | |||
432 433 434 435 436 437 438 | /* Does this platform have wide high-resolution clicks? */ #undef TCL_WIDE_CLICKS /* Do 'long' and 'long long' have the same size (64-bit)? */ #undef TCL_WIDE_INT_IS_LONG | < < < < < < | 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 | /* Does this platform have wide high-resolution clicks? */ #undef TCL_WIDE_CLICKS /* Do 'long' and 'long long' have the same size (64-bit)? */ #undef TCL_WIDE_INT_IS_LONG /* Tcl with external libtommath */ #undef TCL_WITH_EXTERNAL_TOMMATH /* Is getcwd Posix-compliant? */ #undef USEGETWD /* May we include <dirent2.h>? */ #undef USE_DIRENT2_H /* Are we building with DTrace support? */ |
︙ | ︙ | |||
501 502 503 504 505 506 507 | /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE_EXTENDED | | > < < < | < < < | | > | 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 | /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE_EXTENDED /* Define to 1 if type `char' is unsigned and your compiler does not predefine this macro. */ #ifndef __CHAR_UNSIGNED__ # undef __CHAR_UNSIGNED__ #endif /* Define to `int' if <sys/types.h> doesn't define. */ #undef gid_t /* Define to `__inline__' or `__inline' if that's what the C compiler calls it, or to nothing if 'inline' is not supported under any name. */ #ifndef __cplusplus #undef inline #endif /* Define to `int' if <sys/types.h> does not define. */ #undef mode_t /* Define as a signed integer type capable of holding a process identifier. */ #undef pid_t /* Define to `unsigned int' if <sys/types.h> does not define. */ #undef size_t /* Define as int if socklen_t is not available */ #undef socklen_t /* Define to `int' if <sys/types.h> doesn't define. */ #undef uid_t /* Undef unused package specific autoheader defines so that we can * include both tclConfig.h and tkConfig.h at the same time: */ /* override */ #undef PACKAGE_NAME /* override */ #undef PACKAGE_TARNAME /* override */ #undef PACKAGE_VERSION /* override */ #undef PACKAGE_STRING #endif /* _TCLCONFIG */ |
Changes to unix/tclEpollNotfy.c.
1 2 3 4 5 6 7 | /* * tclEpollNotfy.c -- * * This file contains the implementation of the epoll()-based * Linux-specific notifier, which is the lowest-level part of the Tcl * event loop. This file works together with generic/tclNotify.c. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclEpollNotfy.c -- * * This file contains the implementation of the epoll()-based * Linux-specific notifier, which is the lowest-level part of the Tcl * event loop. This file works together with generic/tclNotify.c. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 2016 Lucio Andrés Illanes Albornoz <[email protected]> * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is |
︙ | ︙ | |||
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 | /* 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 */ |
︙ | ︙ | |||
117 118 119 120 121 122 123 | /* * Forward declarations. */ static void PlatformEventsControl(FileHandler *filePtr, ThreadSpecificData *tsdPtr, int op, int isNew); | < | | | | | | < < < | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 | /* * 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. * *---------------------------------------------------------------------- */ | | | > | | 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 | * - 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; struct stat 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 *) Tcl_Alloc(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 (fstat(filePtr->fd, &fdStat) == -1) { Tcl_Panic("fstat: %s", strerror(errno)); } else if ((fdStat.st_mode & S_IFMT) == S_IFREG) { |
︙ | ︙ | |||
273 274 275 276 277 278 279 | Tcl_Panic("epoll_ctl: %s", strerror(errno)); } } /* *---------------------------------------------------------------------- * | | | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 | Tcl_Panic("epoll_ctl: %s", strerror(errno)); } } /* *---------------------------------------------------------------------- * * 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 | | | | 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 | * * 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. * *---------------------------------------------------------------------- */ | | | | | 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 | * 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 *) Tcl_Alloc(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 *) Tcl_Alloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
412 413 414 415 416 417 418 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 | * * 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. * *---------------------------------------------------------------------- */ | | | 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 | * 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 { | | | | | | < < < < < < | | | < < < < | < | | | | | | < < < | | | | | | | | < | | < < < < | | | | | < | | | < < < < | | | | | | | | | | | | | | | | | < | | | < < < | < | < > | > | | < | < | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | > | | | | > | < | < | | | | | | | > | | | < | | | | | | | | | | | | | | | | | | | | | | | | < > > | 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 | */ 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; } } 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 *) Tcl_Alloc(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) { Tcl_Free(filePtr->pedPtr); } /* * Clean up information in the callback record. */ if (prevPtr == NULL) { tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } Tcl_Free(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 *) Tcl_Alloc(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 *) Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } filePtr->readyMask = mask; } 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.
1 2 3 4 5 6 7 8 | /* * tclKqueueNotfy.c -- * * This file contains the implementation of the kqueue()-based * DragonFly/Free/Net/OpenBSD-specific notifier, which is the lowest- * level part of the Tcl event loop. This file works together with * generic/tclNotify.c. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclKqueueNotfy.c -- * * This file contains the implementation of the kqueue()-based * DragonFly/Free/Net/OpenBSD-specific notifier, which is the lowest- * level part of the Tcl event loop. This file works together with * generic/tclNotify.c. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 2016 Lucio Andrés Illanes Albornoz <[email protected]> * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is |
︙ | ︙ | |||
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 | /* 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. */ } 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.) * *---------------------------------------------------------------------- */ | | | > | 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 | * 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; struct stat fdStat; if (isNew) { newPedPtr = (struct PlatformEventData *) Tcl_Alloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; } /* * N.B. As discussed in Tcl_WaitForEvent(), kqueue(2) does not reproduce |
︙ | ︙ | |||
253 254 255 256 257 258 259 | return; } numChanges = 0; switch (op) { case EV_ADD: if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) { | | | | 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 | 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)); |
︙ | ︙ | |||
280 281 282 283 284 285 286 | * 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}. */ | | | | | 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 | * 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 | | | | 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 | * * 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)); } } /* *---------------------------------------------------------------------- * | | > > | | | | 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 | 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)); } | | | > > | | | 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 | } } 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 *) Tcl_Alloc(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 *) Tcl_Alloc( 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. * *---------------------------------------------------------------------- */ | | | 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 | * 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; |
︙ | ︙ | |||
534 535 536 537 538 539 540 | } return numFound; } /* *---------------------------------------------------------------------- * | | | < < < < < < | | | < < < < | < | | | | | | < < < | | | | | | | < | | | < < < | < | | | < | | | < < < < | | | | | | | | | | | | | | | | | < | | | | < < < | | | < > | > | | < | < | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < > > | 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 | } 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 *) Tcl_Alloc(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) { Tcl_Free(filePtr->pedPtr); } /* * Clean up information in the callback record. */ if (prevPtr == NULL) { tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } Tcl_Free(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 *) Tcl_Alloc(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 *) Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } filePtr->readyMask |= mask; } 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/tclLoadAix.c.
1 2 3 4 5 6 7 8 9 10 11 | /* * tclLoadAix.c -- * * This file implements the dlopen and dlsym APIs under the AIX operating * system, to enable the Tcl "load" command to work. This code was * provided by Jens-Uwe Mager. * * This file is subject to the following copyright notice, which is * different from the notice used elsewhere in Tcl. The file has been * modified to incorporate the file dlfcn.h in-line. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | /* * tclLoadAix.c -- * * This file implements the dlopen and dlsym APIs under the AIX operating * system, to enable the Tcl "load" command to work. This code was * provided by Jens-Uwe Mager. * * This file is subject to the following copyright notice, which is * different from the notice used elsewhere in Tcl. The file has been * modified to incorporate the file dlfcn.h in-line. * * Copyright © 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH * Not derived from licensed software. * * Permission is granted to freely use, copy, modify, and redistribute * this software, provided that the author is not construed to be liable * for any results of using the software, alterations are clearly marked * as such, and this notice is not modified. * * Note: this file has been altered from the original in a few ways in order * to work properly with Tcl. */ /* * @(#)dlfcn.c 1.7 revision of 95/08/14 19:08:38 * This is an unpublished work copyright © 1992 HELIOS Software GmbH * 30159 Hannover, Germany */ #include <stdio.h> #include <errno.h> #include <string.h> #include <stdlib.h> |
︙ | ︙ |
Changes to unix/tclLoadDl.c.
1 2 3 4 5 6 | /* * tclLoadDl.c -- * * This procedure provides a version of the TclLoadFile that works with * the "dlopen" and "dlsym" library procedures for dynamic loading. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclLoadDl.c -- * * This procedure provides a version of the TclLoadFile that works with * the "dlopen" and "dlsym" library procedures for dynamic loading. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef NO_DLFCN_H |
︙ | ︙ | |||
254 255 256 257 258 259 260 | * that represents the loaded file. */ { void *handle = loadHandle->clientData; dlclose(handle); Tcl_Free(loadHandle); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 | * that represents the loaded file. */ { void *handle = loadHandle->clientData; dlclose(handle); Tcl_Free(loadHandle); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to unix/tclLoadDyld.c.
1 2 3 4 5 6 7 8 | /* * tclLoadDyld.c -- * * This procedure provides a version of the TclLoadFile that works with * Apple's dyld dynamic loading. * Original version of his file (superseded long ago) provided by * Wilfredo Sanchez ([email protected]). * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclLoadDyld.c -- * * This procedure provides a version of the TclLoadFile that works with * Apple's dyld dynamic loading. * Original version of his file (superseded long ago) provided by * Wilfredo Sanchez ([email protected]). * * Copyright © 1995 Apple Computer, Inc. * Copyright © 2001-2007 Daniel A. Steffen <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
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( |
︙ | ︙ | |||
460 461 462 463 464 465 466 | Tcl_Free(ptr); } #endif /* TCL_DYLD_USE_NSMODULE */ } Tcl_Free(dyldLoadHandle); Tcl_Free(loadHandle); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 460 461 462 463 464 465 466 467 468 469 470 471 472 473 | Tcl_Free(ptr); } #endif /* TCL_DYLD_USE_NSMODULE */ } Tcl_Free(dyldLoadHandle); Tcl_Free(loadHandle); } /* *---------------------------------------------------------------------- * * TclpLoadMemoryGetBuffer -- * * Allocate a buffer that can be used with TclpLoadMemory() below. |
︙ | ︙ |
Changes to unix/tclLoadNext.c.
1 2 3 4 5 6 | /* * tclLoadNext.c -- * * This procedure provides a version of the TclLoadFile that works with * NeXTs rld_* dynamic loading. This file provided by Pedja Bogdanovich. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclLoadNext.c -- * * This procedure provides a version of the TclLoadFile that works with * NeXTs rld_* dynamic loading. This file provided by Pedja Bogdanovich. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include <mach-o/rld.h> |
︙ | ︙ | |||
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); |
︙ | ︙ | |||
173 174 175 176 177 178 179 | UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { Tcl_Free(loadHandle); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 | UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { Tcl_Free(loadHandle); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to unix/tclLoadOSF.c.
︙ | ︙ | |||
22 23 24 25 26 27 28 | * includes: MK6, MK7, AD2, AD3 (from OSF RI) * * This approach to things was utter @&^#; thankfully, OSF/1 eventually * supported dlopen(). * * John Robert LoVerso <[email protected]> * | | | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | * includes: MK6, MK7, AD2, AD3 (from OSF RI) * * This approach to things was utter @&^#; thankfully, OSF/1 eventually * supported dlopen(). * * John Robert LoVerso <[email protected]> * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include <sys/types.h> |
︙ | ︙ | |||
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))); |
︙ | ︙ | |||
191 192 193 194 195 196 197 | UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { Tcl_Free(loadHandle); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 | UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { Tcl_Free(loadHandle); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to unix/tclLoadShl.c.
1 2 3 4 5 6 7 | /* * tclLoadShl.c -- * * This procedure provides a version of the TclLoadFile that works with * the "shl_load" and "shl_findsym" library procedures for dynamic * loading (e.g. for HP machines). * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclLoadShl.c -- * * This procedure provides a version of the TclLoadFile that works with * the "shl_load" and "shl_findsym" library procedures for dynamic * loading (e.g. for HP machines). * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <dl.h> #include "tclInt.h" |
︙ | ︙ | |||
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. */ |
︙ | ︙ | |||
180 181 182 183 184 185 186 | * that represents the loaded file. */ { shl_t handle = (shl_t) loadHandle->clientData; shl_unload(handle); Tcl_Free(loadHandle); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 | * that represents the loaded file. */ { shl_t handle = (shl_t) loadHandle->clientData; shl_unload(handle); Tcl_Free(loadHandle); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to unix/tclSelectNotfy.c.
1 2 3 4 5 6 7 | /* * tclSelectNotfy.c -- * * This file contains the implementation of the select()-based generic * Unix notifier, which is the lowest-level part of the Tcl event loop. * This file works together with generic/tclNotify.c. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclSelectNotfy.c -- * * This file contains the implementation of the select()-based generic * Unix notifier, which is the lowest-level part of the Tcl event loop. * This file works together with generic/tclNotify.c. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is |
︙ | ︙ | |||
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. */ | | | | 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | #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 *, | | | | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | #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); |
︙ | ︙ | |||
267 268 269 270 271 272 273 | static const wchar_t className[] = L"TclNotifier"; static unsigned int __stdcall NotifierProc(void *hwnd, unsigned int message, void *wParam, void *lParam); #ifdef __cplusplus } #endif #endif /* TCL_THREADS && __CYGWIN__ */ | | > > > | | | < < < | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < | > | | | < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | < < < < | | < < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | < < < | | < | | | < | | | < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | 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 | static const wchar_t className[] = L"TclNotifier"; static unsigned int __stdcall NotifierProc(void *hwnd, unsigned int message, void *wParam, void *lParam); #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; } } /* * 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 *) Tcl_Alloc(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; } Tcl_Free(filePtr); } #if defined(__CYGWIN__) static unsigned int __stdcall NotifierProc( void *hwnd, |
︙ | ︙ | |||
621 622 623 624 625 626 627 | return 0; } #endif /* TCL_THREADS && __CYGWIN__ */ /* *---------------------------------------------------------------------- * | | | < < < | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | > | 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 | 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 *) Tcl_Alloc(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; } /* *---------------------------------------------------------------------- * * 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. * *---------------------------------------------------------------------- */ |
︙ | ︙ | |||
1044 1045 1046 1047 1048 1049 1050 | * Alert any threads that are waiting on a ready file descriptor. */ pthread_mutex_lock(¬ifierMutex); for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { found = 0; | | | 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 | * 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)) { |
︙ | ︙ | |||
1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 | 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: */ | > > | 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 | 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/tclUnixChan.c.
1 2 3 4 5 6 | /* * tclUnixChan.c * * Common channel driver for Unix channels based on files, command pipes * and TCP sockets. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclUnixChan.c * * Common channel driver for Unix channels based on files, command pipes * and TCP sockets. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* Internal definitions for Tcl. */ #include "tclIO.h" /* To get Channel type declaration. */ |
︙ | ︙ | |||
125 126 127 128 129 130 131 | static int FileGetHandleProc(void *instanceData, int direction, void **handlePtr); static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); static int FileTruncateProc(void *instanceData, | | | | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | static int FileGetHandleProc(void *instanceData, int direction, void **handlePtr); static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); static int FileTruncateProc(void *instanceData, long long length); static long long FileWideSeekProc(void *instanceData, long long offset, int mode, int *errorCode); static void FileWatchProc(void *instanceData, int mask); #ifdef SUPPORTS_TTY static int TtyCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static void TtyGetAttributes(int fd, TtyAttrs *ttyPtr); static int TtyGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, |
︙ | ︙ | |||
270 271 272 273 274 275 276 | /* * Assume there is always enough input available. This will block * appropriately, and read will unblock as soon as a short read is * possible, if the channel is in blocking mode. If the channel is * nonblocking, the read will never block. */ | > | > > | > | < | | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 | /* * Assume there is always enough input available. This will block * appropriately, and read will unblock as soon as a short read is * possible, if the channel is in blocking mode. If the channel is * nonblocking, the read will never block. */ do { bytesRead = read(fsPtr->fd, buf, toRead); } while ((bytesRead < 0) && (errno == EINTR)); if (bytesRead < 0) { *errorCodePtr = errno; return -1; } return bytesRead; } /* *---------------------------------------------------------------------- * * FileOutputProc-- * |
︙ | ︙ | |||
436 437 438 439 440 441 442 | * Side effects: * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ | | | | | 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 | * Side effects: * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ static long long FileWideSeekProc( void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? Can be * one of SEEK_START, SEEK_CUR or SEEK_END. */ int *errorCodePtr) /* To store error code. */ { FileState *fsPtr = (FileState *)instanceData; long long newLoc; newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode); *errorCodePtr = (newLoc == -1) ? errno : 0; return newLoc; } |
︙ | ︙ | |||
1969 1970 1971 1972 1973 1974 1975 | * *---------------------------------------------------------------------- */ static int FileTruncateProc( void *instanceData, | | | 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 | * *---------------------------------------------------------------------- */ static int FileTruncateProc( void *instanceData, long long length) { FileState *fsPtr = (FileState *)instanceData; int result; #ifdef HAVE_TYPE_OFF64_T /* * We assume this goes with the type for now... |
︙ | ︙ |
Changes to unix/tclUnixCompat.c.
︙ | ︙ | |||
548 549 550 551 552 553 554 | { #if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYNAME) return gethostbyname(name); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETHOSTBYNAME_R_5) | | | | | | 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 | { #if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYNAME) return gethostbyname(name); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETHOSTBYNAME_R_5) int local_errno; return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &local_errno); #elif defined(HAVE_GETHOSTBYNAME_R_6) struct hostent *hePtr = NULL; int local_errno, result; result = gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &hePtr, &local_errno); return (result == 0) ? hePtr : NULL; #elif defined(HAVE_GETHOSTBYNAME_R_3) struct hostent_data data; return (gethostbyname_r(name, &tsdPtr->hent, &data) == 0) ? &tsdPtr->hent : NULL; |
︙ | ︙ | |||
618 619 620 621 622 623 624 | { #if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYADDR) return gethostbyaddr(addr, length, type); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETHOSTBYADDR_R_7) | | | | | | 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 | { #if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYADDR) return gethostbyaddr(addr, length, type); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETHOSTBYADDR_R_7) int local_errno; return gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &local_errno); #elif defined(HAVE_GETHOSTBYADDR_R_8) struct hostent *hePtr; int local_errno; return (gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &hePtr, &local_errno) == 0) ? &tsdPtr->hent : NULL; #else #define NEED_COPYHOSTENT 1 struct hostent *hePtr; Tcl_MutexLock(&compatLock); hePtr = gethostbyaddr(addr, length, type); |
︙ | ︙ | |||
1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 | __asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */ "cpuid \n\t" "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) : "a"(index)); #endif status = TCL_OK; #endif return status; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ | > > > | 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 | __asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */ "cpuid \n\t" "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) : "a"(index)); #endif status = TCL_OK; #else (void)index; (void)regsPtr; #endif return status; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to unix/tclUnixEvent.c.
1 2 3 4 5 | /* * tclUnixEvent.c -- * * This file implements Unix specific event related routines. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclUnixEvent.c -- * * This file implements Unix specific event related routines. * * Copyright © 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is |
︙ | ︙ | |||
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.
1 2 3 4 5 6 7 | /* * tclUnixFCmd.c * * This file implements the unix specific portion of file manipulation * subcommands of the "file" command. All filename arguments should * already be translated to native format. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | /* * tclUnixFCmd.c * * This file implements the unix specific portion of file manipulation * subcommands of the "file" command. All filename arguments should * already be translated to native format. * * Copyright © 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * Portions of this code were derived from NetBSD source code which has the * following copyright notice: * * Copyright © 1988, 1993, 1994 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * 1. Redistributions of source code must retain the above copyright notice, * this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright |
︙ | ︙ | |||
1502 1503 1504 1505 1506 1507 1508 | if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; struct group *groupPtr = NULL; const char *string; size_t length; | | | 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 | if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; struct group *groupPtr = NULL; const char *string; size_t length; string = Tcl_GetStringFromObj(attributePtr, &length); native = Tcl_UtfToExternalDString(NULL, string, length, &ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (groupPtr == NULL) { if (interp != NULL) { |
︙ | ︙ | |||
1569 1570 1571 1572 1573 1574 1575 | if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; size_t length; | | | 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 | if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; size_t length; string = Tcl_GetStringFromObj(attributePtr, &length); native = Tcl_UtfToExternalDString(NULL, string, length, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { if (interp != NULL) { |
︙ | ︙ | |||
1944 1945 1946 1947 1948 1949 1950 | * normalized. I.e. this is not the index of * the byte just after the separator. */ { const char *currentPathEndPosition; char cur; size_t pathLen; | | | 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 | * normalized. I.e. this is not the index of * the byte just after the separator. */ { const char *currentPathEndPosition; char cur; size_t pathLen; const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_DString ds; const char *nativePath; #ifndef NO_REALPATH char normPath[MAXPATHLEN]; #endif currentPathEndPosition = path + nextCheckpoint; |
︙ | ︙ | |||
2174 2175 2176 2177 2178 2179 2180 | size_t length; /* * We should also check against making more then TMP_MAX of these. */ if (dirObj) { | | | | | 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 | size_t length; /* * We should also check against making more then TMP_MAX of these. */ if (dirObj) { string = Tcl_GetStringFromObj(dirObj, &length); Tcl_UtfToExternalDString(NULL, string, length, &templ); } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */ } TclDStringAppendLiteral(&templ, "/"); if (basenameObj) { string = Tcl_GetStringFromObj(basenameObj, &length); Tcl_UtfToExternalDString(NULL, string, length, &tmp); TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { TclDStringAppendLiteral(&templ, "tcl"); } TclDStringAppendLiteral(&templ, "_XXXXXX"); #ifdef HAVE_MKSTEMPS if (extensionObj) { string = Tcl_GetStringFromObj(extensionObj, &length); Tcl_UtfToExternalDString(NULL, string, length, &tmp); TclDStringAppendDString(&templ, &tmp); fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); } else #endif { |
︙ | ︙ | |||
2352 2353 2354 2355 2356 2357 2358 | static void StatError( Tcl_Interp *interp, /* The interp that has the error */ Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { | | | 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 | 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.
1 2 3 4 5 6 | /* * tclUnixFile.c -- * * This file contains wrappers around UNIX file handling functions. * These wrappers mask differences between Windows and UNIX. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclUnixFile.c -- * * This file contains wrappers around UNIX file handling functions. * These wrappers mask differences between Windows and UNIX. * * Copyright © 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclFileSystem.h" |
︙ | ︙ | |||
40 41 42 43 44 45 46 | TCL_UNUSED(const char *) /*argv0*/) { Tcl_Encoding encoding; size_t length; wchar_t buf[PATH_MAX]; char name[PATH_MAX * 3 + 1]; | | | | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | TCL_UNUSED(const char *) /*argv0*/) { Tcl_Encoding encoding; size_t length; wchar_t buf[PATH_MAX]; char name[PATH_MAX * 3 + 1]; GetModuleFileNameW(NULL, buf, sizeof(buf)/sizeof(wchar_t)); 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); TclSetObjNameOfExecutable( |
︙ | ︙ | |||
957 958 959 960 961 962 963 | * -- these must be expanded first). */ transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr); if (transPtr == NULL) { return NULL; } | | | 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 | * -- these must be expanded first). */ transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr); if (transPtr == NULL) { return NULL; } target = Tcl_GetStringFromObj(transPtr, &length); target = Tcl_UtfToExternalDString(NULL, target, length, &ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { toPtr = NULL; } Tcl_DStringFree(&ds); |
︙ | ︙ | |||
1111 1112 1113 1114 1115 1116 1117 | validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (validPathPtr == NULL) { return NULL; } Tcl_IncrRefCount(validPathPtr); } | | | 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 | validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (validPathPtr == NULL) { return NULL; } Tcl_IncrRefCount(validPathPtr); } str = Tcl_GetStringFromObj(validPathPtr, &len); Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { /* See bug [3118489]: NUL in filenames */ Tcl_DecrRefCount(validPathPtr); Tcl_DStringFree(&ds); return NULL; |
︙ | ︙ |
Changes to unix/tclUnixInit.c.
1 2 3 4 5 | /* * tclUnixInit.c -- * * Contains the Unix-specific interpreter initialization functions. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclUnixInit.c -- * * Contains the Unix-specific interpreter initialization functions. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 1999 Scriptics Corporation. * All rights reserved. */ #include "tclInt.h" #ifdef HAVE_LANGINFO # include <langinfo.h> # ifdef __APPLE__ |
︙ | ︙ | |||
42 43 44 45 46 47 48 | DLLIMPORT extern __stdcall void FreeLibrary(void *); DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *); DLLIMPORT extern __stdcall void GetSystemInfo(void *); #ifdef __cplusplus } #endif | | | | | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | DLLIMPORT extern __stdcall void FreeLibrary(void *); DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *); DLLIMPORT extern __stdcall void GetSystemInfo(void *); #ifdef __cplusplus } #endif #define NUMPROCESSORS 15 static const char *const processors[NUMPROCESSORS] = { "i686", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "x86_64", "ia32_on_win64", "neutral", "arm64", "arm32_on_win64", "ia32_on_arm64" }; typedef struct { union { unsigned int dwOemId; struct { int wProcessorArchitecture; |
︙ | ︙ | |||
540 541 542 543 544 545 546 | objPtr = Tcl_NewStringObj(str, -1); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); } } Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); | | | 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 | objPtr = Tcl_NewStringObj(str, -1); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); } } Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); str = Tcl_GetStringFromObj(pathPtr, lengthPtr); *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, str, *lengthPtr + 1); Tcl_DecrRefCount(pathPtr); } /* *--------------------------------------------------------------------------- |
︙ | ︙ | |||
881 882 883 884 885 886 887 | GetVersionExW(&osInfo); } osInfoInitialized = 1; } GetSystemInfo(&sysInfo); | | < | 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 | GetVersionExW(&osInfo); } osInfoInitialized = 1; } GetSystemInfo(&sysInfo); Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", processors[sysInfo.wProcessorArchitecture], TCL_GLOBAL_ONLY); } |
︙ | ︙ |
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 <[email protected]> * 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 | * kqueue(2) notifier: * write(2)s to the trigger pipe(2) of the specified thread. * *---------------------------------------------------------------------- */ void TclpAlertNotifier( ClientData 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); #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 */ } } |
︙ | ︙ | |||
410 411 412 413 414 415 416 | */ } } Tcl_InitNotifier(); } #endif /* HAVE_PTHREAD_ATFORK */ | < < | < | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 | */ } } Tcl_InitNotifier(); } #endif /* HAVE_PTHREAD_ATFORK */ #endif /* TCL_THREADS */ #endif /* NOTIFIER_SELECT */ /* *---------------------------------------------------------------------- * * 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. */ | > > > | 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 | * 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; } | < | | 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 | */ 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/tclUnixPipe.c.
1 2 3 4 5 6 | /* * tclUnixPipe.c -- * * This file implements the UNIX-specific exec pipeline functions, the * "pipe" channel driver, and the "pid" Tcl command. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclUnixPipe.c -- * * This file implements the UNIX-specific exec pipeline functions, the * "pipe" channel driver, and the "pid" Tcl command. * * Copyright © 1991-1994 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to unix/tclUnixPort.h.
︙ | ︙ | |||
88 89 90 91 92 93 94 95 96 97 98 99 100 101 | #ifdef __CYGWIN__ #ifdef __cplusplus extern "C" { #endif /* Make some symbols available without including <windows.h> */ # define CP_UTF8 65001 # define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 # define SOCKET unsigned int # define WSAEWOULDBLOCK 10035 typedef unsigned short WCHAR; #ifdef __clang__ #pragma clang diagnostic push #pragma clang diagnostic ignored "-Wignored-attributes" #endif | > > | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | #ifdef __CYGWIN__ #ifdef __cplusplus extern "C" { #endif /* Make some symbols available without including <windows.h> */ # define CP_UTF8 65001 # define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 # define HMODULE void * # define MAX_PATH 260 # define SOCKET unsigned int # define WSAEWOULDBLOCK 10035 typedef unsigned short WCHAR; #ifdef __clang__ #pragma clang diagnostic push #pragma clang diagnostic ignored "-Wignored-attributes" #endif |
︙ | ︙ | |||
135 136 137 138 139 140 141 | */ #include <sys/file.h> #ifdef HAVE_SYS_SELECT_H # include <sys/select.h> #endif #include <sys/stat.h> | < < < < | | < < | 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | */ #include <sys/file.h> #ifdef HAVE_SYS_SELECT_H # include <sys/select.h> #endif #include <sys/stat.h> #ifdef HAVE_SYS_TIME_H # include <sys/time.h> #endif #include <time.h> #ifndef NO_SYS_WAIT_H # include <sys/wait.h> #endif #ifdef HAVE_INTTYPES_H # include <inttypes.h> #endif #include <limits.h> |
︙ | ︙ |
Changes to unix/tclUnixSock.c.
1 2 3 4 5 | /* * tclUnixSock.c -- * * This file contains Unix-specific socket related code. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclUnixSock.c -- * * This file contains Unix-specific socket related code. * * Copyright © 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to unix/tclUnixTest.c.
1 2 3 4 5 | /* * tclUnixTest.c -- * * Contains platform specific test commands for the Unix platform. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclUnixTest.c -- * * Contains platform specific test commands for the Unix platform. * * Copyright © 1996-1997 Sun Microsystems, Inc. * Copyright © 1998 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS |
︙ | ︙ |
Changes to unix/tclUnixThrd.c.
1 2 3 4 5 | /* * tclUnixThrd.c -- * * This file implements the UNIX-specific thread support. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclUnixThrd.c -- * * This file implements the UNIX-specific thread support. * * Copyright © 1991-1994 The Regents of the University of California. * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 2008 George Peter Staplin * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to unix/tclUnixTime.c.
1 2 3 4 5 6 | /* * tclUnixTime.c -- * * Contains Unix specific versions of Tcl functions that obtain time * values from the operating system. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclUnixTime.c -- * * Contains Unix specific versions of Tcl functions that obtain time * values from the operating system. * * Copyright © 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL) |
︙ | ︙ | |||
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 | /* * 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 * Unix systems the epoch is Midnight Jan 1, 1970 GMT. * * Results: * Number of seconds from the epoch. * * Side effects: * None. * *---------------------------------------------------------------------- */ | > > > > > > > > > > > > > > > > > | | | | | | 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 | /* * 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 * Unix systems the epoch is Midnight Jan 1, 1970 GMT. * * Results: * Number of seconds from the epoch. * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned long long TclpGetSeconds(void) { return (unsigned long long) time(NULL); } /* *---------------------------------------------------------------------- * * TclpGetMicroseconds -- * * This procedure returns the number of microseconds from the epoch. * On most Unix systems the epoch is Midnight Jan 1, 1970 GMT. * * Results: * Number of microseconds from the epoch. * * Side effects: * None. * *---------------------------------------------------------------------- */ long long TclpGetMicroseconds(void) { Tcl_Time time; GetTime(&time); return ((long long)(unsigned long) time.sec)*1000000 + time.usec; } /* *---------------------------------------------------------------------- * * TclpGetClicks -- * |
︙ | ︙ | |||
96 97 98 99 100 101 102 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | | > | | | | | | | 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 | * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned long long TclpGetClicks(void) { unsigned long long now; #ifdef NO_GETTOD if (!IsTimeNative()) { Tcl_Time time; GetTime(&time); now = ((unsigned long long)(unsigned long) time.sec)*1000000 + time.usec; } else { /* * A semi-NativeGetTime, specialized to clicks. */ struct tms dummy; now = (unsigned long long) times(&dummy); } #else /* !NO_GETTOD */ Tcl_Time time; GetTime(&time); now = ((unsigned long long) time.sec)*1000000 + time.usec; #endif /* NO_GETTOD */ return now; } #ifdef TCL_WIDE_CLICKS /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
145 146 147 148 149 150 151 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | | | | | | 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 | * * Side effects: * None. * *---------------------------------------------------------------------- */ 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; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
185 186 187 188 189 190 191 | * None. * *---------------------------------------------------------------------- */ double TclpWideClicksToNanoseconds( | | | | | 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 | * None. * *---------------------------------------------------------------------- */ 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; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
234 235 236 237 238 239 240 | * *---------------------------------------------------------------------- */ double TclpWideClickInMicrosec(void) { | | | < < | < > | | 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 | * *---------------------------------------------------------------------- */ double TclpWideClickInMicrosec(void) { if (!IsTimeNative()) { return 1.0; } else { #ifdef MAC_OSX_TCL static int initialized = 0; static double scale = 0.0; if (!initialized) { 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 */ /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
283 284 285 286 287 288 289 | *---------------------------------------------------------------------- */ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { | | | 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 | *---------------------------------------------------------------------- */ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { GetTime(timePtr); } /* *---------------------------------------------------------------------- * * Tcl_SetTimeProc -- * |
︙ | ︙ |
Changes to unix/tclXtNotify.c.
1 2 3 4 5 6 | /* * tclXtNotify.c -- * * This file contains the notifier driver implementation for the Xt * intrinsics. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclXtNotify.c -- * * This file contains the notifier driver implementation for the Xt * intrinsics. * * Copyright © 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS |
︙ | ︙ | |||
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. */ |
︙ | ︙ | |||
355 356 357 358 359 360 361 | for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { | | | 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 | for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { filePtr = (FileHandler *) Tcl_Alloc(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) { | | | 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 | 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; | | | 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 | } /* * This is an interesting event, so put it onto the event queue. */ filePtr->readyMask |= mask; fileEvPtr = (FileHandlerEvent *) Tcl_Alloc(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.
1 2 3 4 5 | /* * tclXtTest.c -- * * Contains commands for Xt notifier specific tests on Unix. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | /* * tclXtTest.c -- * * Contains commands for Xt notifier specific tests on Unix. * * Copyright © 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include <X11/Intrinsic.h> #include "tcl.h" static Tcl_ObjCmdProc TesteventloopCmd; extern DLLEXPORT Tcl_LibraryInitProc Tclxttest_Init; /* * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: */ extern void InitNotifier(void); extern XtAppContext TclSetAppContext(XtAppContext ctx); |
︙ | ︙ |
Changes to win/Makefile.in.
︙ | ︙ | |||
144 145 146 147 148 149 150 | TCL_VFS_PATH = libtcl.vfs/tcl_library TCL_VFS_ROOT = libtcl.vfs TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ | | | | | | | < | 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 | TCL_VFS_PATH = libtcl.vfs/tcl_library TCL_VFS_ROOT = libtcl.vfs TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ DDE_DLL_FILE = tcl9dde$(DDEVER)${DLLSUFFIX} DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX} REG_DLL_FILE = tcl9registry$(REGVER)${DLLSUFFIX} REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX} TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_EXE_FILE = tcltest${EXESUFFIX} TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX} TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ package ifneeded dde 1.4.4 [list load [file normalize ${DDE_DLL_FILE}]];\ package ifneeded registry 1.3.6 [list load [file normalize ${REG_DLL_FILE}]] TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\ $(TEST_LOAD_PRMS) ZLIB_DLL_FILE = zlib1.dll TOMMATH_DLL_FILE = libtommath.dll SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} WINE = @WINE@ CAT32 = cat32$(EXEEXT) # For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is # available *BEFORE* running make for the first time. Certain build targets # (make genstubs, make install) need it to be available on the PATH. This # executable should *NOT* be required just to do a normal build although # it can be required to run make dist. TCL_EXE = @TCL_EXE@ |
︙ | ︙ | |||
411 412 413 414 415 416 417 418 419 420 421 422 423 424 | bn_mp_sqrt.${OBJEXT} \ bn_mp_sub.${OBJEXT} \ bn_mp_sub_d.${OBJEXT} \ bn_mp_signed_rsh.${OBJEXT} \ bn_mp_to_ubin.${OBJEXT} \ bn_mp_to_radix.${OBJEXT} \ bn_mp_ubin_size.${OBJEXT} \ bn_mp_xor.${OBJEXT} \ bn_mp_zero.${OBJEXT} \ bn_s_mp_add.${OBJEXT} \ bn_s_mp_balance_mul.$(OBJEXT) \ bn_s_mp_karatsuba_mul.${OBJEXT} \ bn_s_mp_karatsuba_sqr.$(OBJEXT) \ bn_s_mp_mul_digs.${OBJEXT} \ | > | 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 | bn_mp_sqrt.${OBJEXT} \ bn_mp_sub.${OBJEXT} \ bn_mp_sub_d.${OBJEXT} \ bn_mp_signed_rsh.${OBJEXT} \ bn_mp_to_ubin.${OBJEXT} \ bn_mp_to_radix.${OBJEXT} \ bn_mp_ubin_size.${OBJEXT} \ bn_mp_unpack.${OBJEXT} \ bn_mp_xor.${OBJEXT} \ bn_mp_zero.${OBJEXT} \ bn_s_mp_add.${OBJEXT} \ bn_s_mp_balance_mul.$(OBJEXT) \ bn_s_mp_karatsuba_mul.${OBJEXT} \ bn_s_mp_karatsuba_sqr.$(OBJEXT) \ bn_s_mp_mul_digs.${OBJEXT} \ |
︙ | ︙ | |||
449 450 451 452 453 454 455 456 457 458 459 460 461 462 | DDE_OBJS = tclWinDde.$(OBJEXT) REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ tclOOStubLib.$(OBJEXT) \ tclWinPanic.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) ZLIB_OBJS = \ | > > | 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 | DDE_OBJS = tclWinDde.$(OBJEXT) REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ tclStubCall.$(OBJEXT) \ tclStubLibTbl.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ tclOOStubLib.$(OBJEXT) \ tclWinPanic.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) ZLIB_OBJS = \ |
︙ | ︙ | |||
520 521 522 523 524 525 526 | tclzipfile: ${TCL_ZIP_FILE} ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE} @rm -rf ${TCL_VFS_ROOT} @mkdir -p ${TCL_VFS_PATH} @echo "creating ${TCL_VFS_PATH} (prepare compression)" @( \ | < < < < < < < < < | | > > > > > | | | | | 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 | tclzipfile: ${TCL_ZIP_FILE} ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE} @rm -rf ${TCL_VFS_ROOT} @mkdir -p ${TCL_VFS_PATH} @echo "creating ${TCL_VFS_PATH} (prepare compression)" @( \ $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \ $(COPY) -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \ $(COPY) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde; \ $(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/registry; \ ) (zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}') 2>/dev/null || \ (echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?")`; \ cd ${TCL_VFS_ROOT} && \ $$zip ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} >/dev/null && \ echo "${TCL_ZIP_FILE} successful created with $$zip" && \ 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) $(CAT32): cat32.$(OBJEXT) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) # The following targets are configured by autoconf to generate either a shared # library or static library ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} @MAKE_STUB_LIB@ ${STUB_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ ${TCL_ZIP_FILE} @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${TCL_DLL_FILE}.manifest @VC_MANIFEST_EMBED_DLL@ @if test "${ZIPFS_BUILD}" = "1" ; then \ cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}; \ ${NATIVE_ZIP} -A ${TCL_DLL_FILE} \ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ 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} @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 |
︙ | ︙ | |||
645 646 647 648 649 650 651 | tclMainW.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) # TIP #430, ZipFS Support tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl \ | < < < < < | 643 644 645 646 647 648 649 650 651 652 653 654 655 656 | tclMainW.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) # TIP #430, ZipFS Support tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl \ $(ZLIB_INCLUDE) -I$(MINIZIP_DIR_NATIVE) @DEPARG@ $(CC_OBJNAME) # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed # and where it will look for its libraries (which can be different). We derive |
︙ | ︙ | |||
675 676 677 678 679 680 681 | \ -DCFG_RUNTIME_LIBDIR="\"$(libdir_native)\"" \ -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)\"" \ | < > > > > > > > > > | | | 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 | \ -DCFG_RUNTIME_LIBDIR="\"$(libdir_native)\"" \ -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) tclStubCall.${OBJEXT}: tclStubCall.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ -DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \ @DEPARG@ $(CC_OBJNAME) tclStubLibTbl.${OBJEXT}: tclStubLibTbl.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c $(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) tclOOStubLib.${OBJEXT}: tclOOStubLib.c $(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) tclWinPanic.${OBJEXT}: tclWinPanic.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) # Implicit rule for all object files that will end up in the Tcl library %.${OBJEXT}: %.c |
︙ | ︙ | |||
787 788 789 790 791 792 793 | if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(MKDIR) "$$i"; \ chmod 755 "$$i"; \ else true; \ fi; \ done; | | | 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 | if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(MKDIR) "$$i"; \ chmod 755 "$$i"; \ else true; \ fi; \ done; @for i in dde${DDEDOTVER} registry${REGDOTVER}; \ do \ if [ ! -d "$(LIB_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ $(MKDIR) "$(LIB_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; |
︙ | ︙ | |||
821 822 823 824 825 826 827 | fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo Installing $(DDE_LIB_FILE); \ $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo Installing $(REG_DLL_FILE); \ | | | | | < < < < < | 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 | fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo Installing $(DDE_LIB_FILE); \ $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo Installing $(REG_DLL_FILE); \ $(COPY) $(REG_DLL_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ $(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \ "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ fi @if [ -f $(REG_LIB_FILE) ]; then \ echo Installing $(REG_LIB_FILE); \ $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ fi install-libraries: libraries install-tzdata install-msgs @for i in "$(prefix)/lib" "$(INCLUDE_INSTALL_DIR)" \ "$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(MKDIR) "$$i"; \ |
︙ | ︙ | |||
880 881 882 883 884 885 886 | @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)/9.0/msgcat-1.7.1.tm"; | | | | | | 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 | @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)/9.0/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)/9.0/tcltest-2.5.4.tm"; @echo "Installing package platform 1.0.17 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.17.tm"; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/9.0/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; |
︙ | ︙ | |||
977 978 979 980 981 982 983 | depend: Makefile: $(SRC_DIR)/Makefile.in ./config.status cleanhelp: | | | < | | 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 | depend: Makefile: $(SRC_DIR)/Makefile.in ./config.status cleanhelp: $(RM) *.hlp *.cnt *.GID clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out $(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd tcltest.sh $(RM) *.pch *.ilk *.pdb *.zip $(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT} $(RMDIR) *.vfs distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ config.status.lineno tclsh.exe.manifest # # Bundled package targets # PKG_CFG_ARGS = @PKG_CFG_ARGS@ PKG_DIR = ./pkgs |
︙ | ︙ | |||
1118 1119 1120 1121 1122 1123 1124 | .PHONY: all tcltest binaries libraries doc gendate gentommath_h install .PHONY: install-binaries install-libraries install-tzdata install-msgs .PHONY: install-doc install-private-headers test test-tcl runtest shell .PHONY: gdb depend cleanhelp clean distclean packages install-packages .PHONY: test-packages clean-packages distclean-packages genstubs html .PHONY: html-tcl html-tk | | | 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 | .PHONY: all tcltest binaries libraries doc gendate gentommath_h install .PHONY: install-binaries install-libraries install-tzdata install-msgs .PHONY: install-doc install-private-headers test test-tcl runtest shell .PHONY: gdb depend cleanhelp clean distclean packages install-packages .PHONY: test-packages clean-packages distclean-packages genstubs html .PHONY: html-tcl html-tk .PHONY: tclzipfile # DO NOT DELETE THIS LINE -- make depend depends on it. |
Changes to win/buildall.vc.bat.
︙ | ︙ | |||
64 65 66 67 68 69 70 | set OPTS=none if not %SYMBOLS%.==. set OPTS=symbols nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1 if errorlevel 1 goto error :: Build the static core and shell. :: | | | | 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | set OPTS=none if not %SYMBOLS%.==. set OPTS=symbols nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1 if errorlevel 1 goto error :: Build the static core and shell. :: set OPTS=static if not %SYMBOLS%.==. set OPTS=symbols,static nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1 if errorlevel 1 goto error set OPTS= set SYMBOLS= goto end |
︙ | ︙ |
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 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 | #! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.70 for tcl 9.0. # # # Copyright (C) 1992-1996, 1998-2017, 2020 Free Software Foundation, Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else $as_nop case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Use a proper internal environment variable to ensure we don't fall # into an infinite loop, continuously re-executing ourselves. if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then _as_can_reexec=no; export _as_can_reexec; # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also |
︙ | ︙ | |||
148 149 150 151 152 153 154 | *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. | | | | > > | | > | > > | > | | > | > | > > > | | > | > > > > > > | | > | < > | > | | > | | | | | | | 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 | *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="as_nop=: if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST else \$as_nop case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi " as_required="as_fn_return () { (exit \$1); } as_fn_success () { as_fn_return 0; } as_fn_failure () { as_fn_return 1; } as_fn_ret_success () { return 0; } as_fn_ret_failure () { return 1; } exitcode=0 as_fn_success || { exitcode=1; echo as_fn_success failed.; } as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : else \$as_nop exitcode=1; echo positional parameters were not saved. fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah)) test x\"\$blah\" = xblah || exit 1 test -x / || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 test \$(( 1 + 1 )) = 2 || exit 1" if (eval "$as_required") 2>/dev/null then : as_have_required=yes else $as_nop as_have_required=no fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : else $as_nop as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac as_found=: case $as_dir in #( /*) for as_base in sh bash ksh sh5; do # Try only shells that exist, to save several forks. as_shell=$as_dir$as_base if { test -f "$as_shell" || test -f "$as_shell.exe"; } && as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$as_shell as_have_required=yes if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null then : break 2 fi fi done;; esac as_found=false done IFS=$as_save_IFS if $as_found then : else $as_nop if { test -f "$SHELL" || test -f "$SHELL.exe"; } && as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$SHELL as_have_required=yes fi fi if test "x$CONFIG_SHELL" != x then : export CONFIG_SHELL # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi if test x$as_have_required = xno then : printf "%s\n" "$0: This script requires a shell more modern than all" printf "%s\n" "$0: the shells that I found on your system." if test ${ZSH_VERSION+y} ; then printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should" printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later." else printf "%s\n" "$0: Please tell [email protected] about your system, $0: including any error possibly output before this $0: message. Then install a modern shell, or manually run $0: the script under such a shell if you do have one." fi exit 1 fi fi |
︙ | ︙ | |||
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 | # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( | > > > > > > > > > | | | 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 | # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_nop # --------- # Do nothing but, unlike ":", preserve the value of $?. as_fn_nop () { return $? } as_nop=as_fn_nop # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q |
︙ | ︙ | |||
366 367 368 369 370 371 372 | } # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. | | > | | > | > > > > > > > > | | | 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 | } # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else $as_nop as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else $as_nop as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith # as_fn_nop # --------- # Do nothing but, unlike ":", preserve the value of $?. as_fn_nop () { return $? } as_nop=as_fn_nop # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else |
︙ | ︙ | |||
435 436 437 438 439 440 441 | as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || | | | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 | as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q |
︙ | ︙ | |||
479 480 481 482 483 484 485 | N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || | | > > > > > > > > > > > | 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 | N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } # If we had to re-execute with $CONFIG_SHELL, we're ensured to have # already done that, so ensure we don't try to do so again and fall # in an infinite loop. This has already happened in practice. _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null |
︙ | ︙ | |||
571 572 573 574 575 576 577 | LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. | | | | | | | | | | | < < < < < < < < < < < < < < > > > > > > > > > > | 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 | LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' PACKAGE_VERSION='9.0' PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' ac_unique_file="../generic/tcl.h" # Factoring default headers for most tests. ac_includes_default="\ #include <stddef.h> #ifdef HAVE_STDIO_H # include <stdio.h> #endif #ifdef HAVE_STDLIB_H # include <stdlib.h> #endif #ifdef HAVE_STRING_H # include <string.h> #endif #ifdef HAVE_INTTYPES_H # include <inttypes.h> #endif #ifdef HAVE_STDINT_H # include <stdint.h> #endif #ifdef HAVE_STRINGS_H # include <strings.h> #endif #ifdef HAVE_SYS_TYPES_H # include <sys/types.h> #endif #ifdef HAVE_SYS_STAT_H # include <sys/stat.h> #endif #ifdef HAVE_UNISTD_H # include <unistd.h> #endif" ac_header_c_list= ac_subst_vars='LTLIBOBJS LIBOBJS RES RC_DEFINES RC_DEFINE RC_INCLUDE RC_TYPE |
︙ | ︙ | |||
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 | TCL_MINOR_VERSION TCL_MAJOR_VERSION TCL_VERSION MACHINE TCL_WIN_VERSION VC_MANIFEST_EMBED_EXE VC_MANIFEST_EMBED_DLL LDFLAGS_DEFAULT CFLAGS_DEFAULT INSTALL_MSGS INSTALL_LIBRARIES TCL_ZIP_FILE ZIPFS_BUILD ZIP_INSTALL_OBJS ZIP_PROG_VFSSEARCH ZIP_PROG_OPTIONS ZIP_PROG TCLSH_PROG EXEEXT_FOR_BUILD CC_FOR_BUILD TOMMATH_OBJS ZLIB_OBJS TOMMATH_LIBS ZLIB_LIBS TOMMATH_DLL_FILE ZLIB_DLL_FILE CFLAGS_WARNING CFLAGS_OPTIMIZE CFLAGS_DEBUG DL_LIBS WINE CYGPATH SHARED_BUILD SET_MAKE RC RANLIB AR | > > > > < < < | 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 | TCL_MINOR_VERSION TCL_MAJOR_VERSION TCL_VERSION MACHINE TCL_WIN_VERSION VC_MANIFEST_EMBED_EXE VC_MANIFEST_EMBED_DLL EGREP GREP CPP LDFLAGS_DEFAULT CFLAGS_DEFAULT INSTALL_MSGS INSTALL_LIBRARIES TCL_ZIP_FILE ZIPFS_BUILD ZIP_INSTALL_OBJS ZIP_PROG_VFSSEARCH ZIP_PROG_OPTIONS ZIP_PROG TCLSH_PROG EXEEXT_FOR_BUILD CC_FOR_BUILD TOMMATH_OBJS ZLIB_OBJS TOMMATH_LIBS ZLIB_LIBS TOMMATH_DLL_FILE ZLIB_DLL_FILE CFLAGS_NOLTO CFLAGS_WARNING CFLAGS_OPTIMIZE CFLAGS_DEBUG DL_LIBS WINE CYGPATH SHARED_BUILD SET_MAKE RC RANLIB AR OBJEXT EXEEXT ac_ct_CC CPPFLAGS LDFLAGS CFLAGS CC |
︙ | ︙ | |||
751 752 753 754 755 756 757 758 759 760 761 762 763 764 | pdfdir dvidir htmldir infodir docdir oldincludedir includedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir | > | 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 | pdfdir dvidir htmldir infodir docdir oldincludedir includedir runstatedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir |
︙ | ︙ | |||
828 829 830 831 832 833 834 835 836 | sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' | > | | 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 | sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' |
︙ | ︙ | |||
857 858 859 860 861 862 863 | case $ac_option in *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *=) ac_optarg= ;; *) ac_optarg=yes ;; esac | < < | 886 887 888 889 890 891 892 893 894 895 896 897 898 899 | case $ac_option in *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *=) ac_optarg= ;; *) ac_optarg=yes ;; esac case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) |
︙ | ︙ | |||
899 900 901 902 903 904 905 | | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && | | | | 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 | | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac |
︙ | ︙ | |||
925 926 927 928 929 930 931 | -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && | | | | 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 | -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac |
︙ | ︙ | |||
1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 | ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; | > > > > > > > > > | 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 | ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -runstatedir | --runstatedir | --runstatedi | --runstated \ | --runstate | --runstat | --runsta | --runst | --runs \ | --run | --ru | --r) ac_prev=runstatedir ;; -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ | --run=* | --ru=* | --r=*) runstatedir=$ac_optarg ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; |
︙ | ︙ | |||
1129 1130 1131 1132 1133 1134 1135 | -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && | | | | | | 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 | -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac |
︙ | ︙ | |||
1191 1192 1193 1194 1195 1196 1197 | as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. | | | | | | 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 | as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2 : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` eval $ac_var=\$ac_val;; |
︙ | ︙ | |||
1273 1274 1275 1276 1277 1278 1279 | ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || | | | 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 | ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q |
︙ | ︙ | |||
1330 1331 1332 1333 1334 1335 1336 | # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF | | | 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 | # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures tcl 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. |
︙ | ︙ | |||
1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 | Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] | > | | > > | 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 | Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/tcl] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of tcl 9.0:";; esac cat <<\_ACEOF Optional Features: --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-shared build and link with shared libraries (default: on) |
︙ | ︙ | |||
1438 1439 1440 1441 1442 1443 1444 | { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) | | | | 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 | { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix |
︙ | ︙ | |||
1468 1469 1470 1471 1472 1473 1474 | ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } | | > | | | | | | | | > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | | < < < < | < | < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < | < < < < < < < < < < < < < | < < < | < | < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | > | < < < < < < < < < < < | | | | 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 | ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for configure.gnu first; this name is used for a wrapper for # Metaconfig's "Configure" on case-insensitive file systems. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 9.0 generated by GNU Autoconf 2.70 Copyright (C) 2020 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## ## Autoconf initialization. ## ## ------------------------ ## # ac_fn_c_try_compile LINENO # -------------------------- # Try to compile conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile # ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES # ------------------------------------------------------- # Tests whether HEADER exists and can be compiled using the include files in # INCLUDES, setting the cache variable VAR accordingly. ac_fn_c_check_header_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 #include <$2> _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$3=yes" else $as_nop eval "$3=no" fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_compile # ac_fn_c_check_type LINENO TYPE VAR INCLUDES # ------------------------------------------- # Tests whether TYPE exists after having included INCLUDES, setting cache # variable VAR accordingly. ac_fn_c_check_type () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 else $as_nop eval "$3=no" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 int main (void) { if (sizeof ($2)) return 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 int main (void) { if (sizeof (($2))) return 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : else $as_nop eval "$3=yes" 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 fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_type # ac_fn_c_try_cpp LINENO # ---------------------- # Try to preprocess conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_cpp () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack if { { ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } > conftest.i && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err } then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_cpp ac_configure_args_raw= for ac_arg do case $ac_arg in *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac as_fn_append ac_configure_args_raw " '$ac_arg'" done case $ac_configure_args_raw in *$as_nl*) ac_safe_unquote= ;; *) ac_unsafe_z='|&;<>()$`\\"*?[ '' ' # This string ends in space, tab. ac_unsafe_a="$ac_unsafe_z#~" ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g" ac_configure_args_raw=` printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;; esac cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 9.0, which was generated by GNU Autoconf 2.70. Invocation command line was $ $0$ac_configure_args_raw _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## |
︙ | ︙ | |||
1827 1828 1829 1830 1831 1832 1833 | _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS | > | > > > | | 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 | _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac printf "%s\n" "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF |
︙ | ︙ | |||
1863 1864 1865 1866 1867 1868 1869 | do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) | | | 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 | do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. |
︙ | ︙ | |||
1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 | # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo | > > | | | | 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 | # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Sanitize IFS. IFS=" "" $as_nl" # Save into config.log some information that might help in debugging. { echo printf "%s\n" "## ---------------- ## ## Cache variables. ## ## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac |
︙ | ︙ | |||
1938 1939 1940 1941 1942 1943 1944 | sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo | | | | | | | | | | | < | < < | < < | < < | < < | < < | < < < < | < < < < | < | < > | | > > > > > | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | | | | | > | > | 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 | sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo printf "%s\n" "## ----------------- ## ## Output variables. ## ## ----------------- ##" echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then printf "%s\n" "## ------------------- ## ## File substitutions. ## ## ------------------- ##" echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then printf "%s\n" "## ----------- ## ## confdefs.h. ## ## ----------- ##" echo cat confdefs.h echo fi test "$ac_signal" != 0 && printf "%s\n" "$as_me: caught signal $ac_signal" printf "%s\n" "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h printf "%s\n" "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h # Let the site file select an alternate cache file if it wants to. # Prefer an explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then ac_site_files="$CONFIG_SITE" elif test "x$prefix" != xNONE; then ac_site_files="$prefix/share/config.site $prefix/etc/config.site" else ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi for ac_site_file in $ac_site_files do case $ac_site_file in #( */*) : ;; #( *) : ac_site_file=./$ac_site_file ;; esac if test -f "$ac_site_file" && test -r "$ac_site_file"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file See \`config.log' for more details" "$LINENO" 5; } fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special files # actually), so we avoid doing that. DJGPP emulates it as a regular file. if test /dev/null != "$cache_file" && test -f "$cache_file"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 printf "%s\n" "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 printf "%s\n" "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Test code for whether the C compiler supports C89 (global declarations) ac_c_conftest_c89_globals=' /* Does the compiler advertise C89 conformance? Do not test the value of __STDC__, because some compilers set it to 0 while being otherwise adequately conformant. */ #if !defined __STDC__ # error "Compiler does not advertise C89 conformance" #endif #include <stddef.h> #include <stdarg.h> struct stat; /* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not \xHH hex character constants. These do not provoke an error unfortunately, instead are silently treated as an "x". The following induces an error, until -std is added to get proper ANSI mode. Curiously \x00 != x always comes out true, for an array size at least. It is necessary to write \x00 == 0 to get something that is true only with -std. */ int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) '\''x'\'' int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int), int, int);' # Test code for whether the C compiler supports C89 (body of main). ac_c_conftest_c89_main=' ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); ' # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals=' // Does the compiler advertise C99 conformance? #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif #include <stdbool.h> extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t); // Check varargs macros. These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare // FILE and stderr. #define debug(...) dprintf (2, __VA_ARGS__) #define showlist(...) puts (#__VA_ARGS__) #define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) static void test_varargs_macros (void) { int x = 1234; int y = 5678; debug ("Flag"); debug ("X = %d\n", x); showlist (The first, second, and third items.); report (x>y, "x is %d but y is %d", x, y); } // Check long long types. #define BIG64 18446744073709551615ull #define BIG32 4294967295ul #define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) #if !BIG_OK #error "your preprocessor is broken" #endif #if BIG_OK #else #error "your preprocessor is broken" #endif static long long int bignum = -9223372036854775807LL; static unsigned long long int ubignum = BIG64; struct incomplete_array { int datasize; double data[]; }; struct named_init { int number; const wchar_t *name; double average; }; typedef const char *ccp; static inline int test_restrict (ccp restrict text) { // See if C++-style comments work. // Iterate through items via the restricted pointer. // Also check for declarations in for loops. for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) continue; return 0; } // Check varargs and va_copy. static bool test_varargs (const char *format, ...) { va_list args; va_start (args, format); va_list args_copy; va_copy (args_copy, args); const char *str = ""; int number = 0; float fnumber = 0; while (*format) { switch (*format++) { case '\''s'\'': // string str = va_arg (args_copy, const char *); break; case '\''d'\'': // int number = va_arg (args_copy, int); break; case '\''f'\'': // float fnumber = va_arg (args_copy, double); break; default: break; } } va_end (args_copy); va_end (args); return *str && number && fnumber; } ' # Test code for whether the C compiler supports C99 (body of main). ac_c_conftest_c99_main=' // Check bool. _Bool success = false; success |= (argc != 0); // Check restrict. if (test_restrict ("String literal") == 0) success = true; char *restrict newvar = "Another string"; // Check varargs. success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234); test_varargs_macros (); // Check flexible array members. struct incomplete_array *ia = malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); ia->datasize = 10; for (int i = 0; i < ia->datasize; ++i) ia->data[i] = i * 1.234; // Check named initializers. struct named_init ni = { .number = 34, .name = L"Test wide string", .average = 543.34343, }; ni.number = 58; int dynamic_array[ni.number]; dynamic_array[0] = argv[0][0]; dynamic_array[ni.number - 1] = 543; // work around unused variable warnings ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\'' || dynamic_array[ni.number - 1] != 543); ' # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals=' // Does the compiler advertise C11 conformance? #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif // Check _Alignas. char _Alignas (double) aligned_as_double; char _Alignas (0) no_special_alignment; extern char aligned_as_int; char _Alignas (0) _Alignas (int) aligned_as_int; // Check _Alignof. enum { int_alignment = _Alignof (int), int_array_alignment = _Alignof (int[100]), char_alignment = _Alignof (char) }; _Static_assert (0 < -_Alignof (int), "_Alignof is signed"); // Check _Noreturn. int _Noreturn does_not_return (void) { for (;;) continue; } // Check _Static_assert. struct test_static_assert { int x; _Static_assert (sizeof (int) <= sizeof (long int), "_Static_assert does not work in struct"); long int y; }; // Check UTF-8 literals. #define u8 syntax error! char const utf8_literal[] = u8"happens to be ASCII" "another string"; // Check duplicate typedefs. typedef long *long_ptr; typedef long int *long_ptr; typedef long_ptr long_ptr; // Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1. struct anonymous { union { struct { int i; int j; }; struct { int k; long int l; } w; }; int m; } v1; ' # Test code for whether the C compiler supports C11 (body of main). ac_c_conftest_c11_main=' _Static_assert ((offsetof (struct anonymous, i) == offsetof (struct anonymous, w.k)), "Anonymous union alignment botch"); v1.i = 2; v1.w.k = 5; ok |= v1.i != 5; ' # Test code for whether the C compiler supports C11 (complete). ac_c_conftest_c11_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} ${ac_c_conftest_c11_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} ${ac_c_conftest_c11_main} return ok; } " # Test code for whether the C compiler supports C99 (complete). ac_c_conftest_c99_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} return ok; } " # Test code for whether the C compiler supports C89 (complete). ac_c_conftest_c89_program="${ac_c_conftest_c89_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} return ok; } " as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H" as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H" as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H" as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H" as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H" as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H" as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H" as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H" as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H" # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then # differences in whitespace do not lead to failure. ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 printf "%s\n" "$as_me: former value: \`$ac_old_val'" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## ## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. |
︙ | ︙ | |||
2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 | #------------------------------------------------------------------------ # If the user did not set CFLAGS, set it now to keep # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 | > > > > > > > > > | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | > | | | > | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | > | | | | | | > | | | | | | | | | > | | | | > | | | | > > | | | | > | | | | > | | | > | | | > | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < | > | > | | | | | | | | | > | | | > > > > > > > > > | | | > | | | | | > | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | | | | > | | | | | | | > < | < | | | | > | < < < < < < < < | | | | | < | < > | | | > > > > > > > > > > | | | | | | > | > > | | | > | | | | | | | > | | > | > > > | | | | | | | | | > | | > | > > > | | | | | | | | | > | | | | > | | | | | 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 | #------------------------------------------------------------------------ # If the user did not set CFLAGS, set it now to keep # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. set dummy ${ac_tool_prefix}clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "clang", so it can be a program name with args. set dummy clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi fi test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 set X $ac_compile ac_compiler=$2 for ac_option in --version -v -V -qversion -version; do { { ac_try="$ac_compiler $ac_option >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compiler $ac_option >&5") 2>conftest.err ac_status=$? if test -s conftest.err; then sed '10a\ ... rest of stderr output deleted ... 10q' conftest.err >conftest.er1 cat conftest.er1 >&5 fi rm -f conftest.er1 conftest.err printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } done cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 printf %s "checking whether the C compiler works... " >&6; } ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # The possible output files: ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { { ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link_default") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else $as_nop ac_file='' fi if test -z "$ac_file" then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables See \`config.log' for more details" "$LINENO" 5; } else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; } { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 printf "%s\n" "$ac_file" >&6; } ac_exeext=$ac_cv_exeext rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 printf %s "checking for suffix of executables... " >&6; } if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else $as_nop { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 printf "%s\n" "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <stdio.h> int main (void) { FILE *f = fopen ("conftest.out", "w"); return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF ac_clean_files="$ac_clean_files conftest.out" # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 printf %s "checking whether we are cross compiling... " >&6; } if test "$cross_compiling" != yes; then { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } if { ac_try='./conftest$ac_cv_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details" "$LINENO" 5; } fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 printf %s "checking whether the compiler supports GNU C... " >&6; } if test ${ac_cv_c_compiler_gnu+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_compiler_gnu=yes else $as_nop ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } ac_compiler_gnu=$ac_cv_c_compiler_gnu if test $ac_compiler_gnu = yes; then GCC=yes else GCC= fi ac_test_CFLAGS=${CFLAGS+y} ac_save_CFLAGS=$CFLAGS { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 printf %s "checking whether $CC accepts -g... " >&6; } if test ${ac_cv_prog_cc_g+y} then : printf %s "(cached) " >&6 else $as_nop ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes else $as_nop CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : else $as_nop ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext 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 ac_c_werror_flag=$ac_save_c_werror_flag fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; } if test $ac_test_CFLAGS; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { 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 cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c11_program _ACEOF for ac_arg in '' -std=gnu11 do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c11=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL ac_prog_cc_stdc_options= case "x$ac_cv_prog_cc_c11" in #( x) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } ;; #( xno) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } ;; #( *) : ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c11" CC="$CC$ac_prog_cc_stdc_options" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } ;; esac if test "x$ac_cv_prog_cc_c11" != xno then : ac_prog_cc_stdc=c11 ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 else $as_nop { 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_c89_program _ACEOF for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99 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 # AC_CACHE_VAL ac_prog_cc_stdc_options= case "x$ac_cv_prog_cc_c99" in #( x) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } ;; #( xno) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } ;; #( *) : ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c99" CC="$CC$ac_prog_cc_stdc_options" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } ;; esac if test "x$ac_cv_prog_cc_c99" != xno then : ac_prog_cc_stdc=c99 ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 else $as_nop { 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 # AC_CACHE_VAL ac_prog_cc_stdc_options= case "x$ac_cv_prog_cc_c89" in #( x) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } ;; #( xno) : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } ;; #( *) : ac_prog_cc_stdc_options=" $ac_cv_prog_cc_c89" CC="$CC$ac_prog_cc_stdc_options" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } ;; esac if test "x$ac_cv_prog_cc_c89" != xno then : ac_prog_cc_stdc=c89 ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 else $as_nop ac_prog_cc_stdc=no ac_cv_prog_cc_stdc=no fi fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 printf %s "checking for inline... " >&6; } if test ${ac_cv_c_inline+y} then : printf %s "(cached) " >&6 else $as_nop ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef __cplusplus typedef int foo_t; static $ac_kw foo_t static_foo (void) {return 0; } $ac_kw foo_t foo (void) {return 0; } #endif _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_c_inline=$ac_kw fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext test "$ac_cv_c_inline" != no && break done fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 printf "%s\n" "$ac_cv_c_inline" >&6; } case $ac_cv_c_inline in inline | yes) ;; *) case $ac_cv_c_inline in no) ac_val=;; *) ac_val=$ac_cv_c_inline;; esac cat >>confdefs.h <<_ACEOF #ifndef __cplusplus #define inline $ac_val #endif _ACEOF ;; esac if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_AR+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_AR="${ac_tool_prefix}ar" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 printf "%s\n" "$AR" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_AR+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AR="ar" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 printf "%s\n" "$ac_ct_AR" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_AR" = x; then AR="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac AR=$ac_ct_AR fi else AR="$ac_cv_prog_AR" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_RANLIB+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 printf "%s\n" "$RANLIB" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_RANLIB+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 printf "%s\n" "$ac_ct_RANLIB" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_RANLIB" = x; then RANLIB="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac RANLIB=$ac_ct_RANLIB fi else RANLIB="$ac_cv_prog_RANLIB" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args. set dummy ${ac_tool_prefix}windres; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_RC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$RC"; then ac_cv_prog_RC="$RC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_RC="${ac_tool_prefix}windres" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi RC=$ac_cv_prog_RC if test -n "$RC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RC" >&5 printf "%s\n" "$RC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_RC"; then ac_ct_RC=$RC # Extract the first word of "windres", so it can be a program name with args. set dummy windres; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_RC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_RC"; then ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RC="windres" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_RC=$ac_cv_prog_ac_ct_RC if test -n "$ac_ct_RC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5 printf "%s\n" "$ac_ct_RC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_RC" = x; then RC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac RC=$ac_ct_RC fi else RC="$ac_cv_prog_RC" fi #-------------------------------------------------------------------- # Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 printf %s "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } set x ${MAKE-make} ac_make=`printf "%s\n" "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if eval test \${ac_cv_prog_make_${ac_make}_set+y} then : printf %s "(cached) " >&6 else $as_nop cat >conftest.make <<\_ACEOF SHELL = /bin/sh all: @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF # GNU make sometimes prints "make[1]: Entering ...", which would confuse us. case `${MAKE-make} -f conftest.make 2>/dev/null` in *@@@%%%=?*=@@@%%%*) eval ac_cv_prog_make_${ac_make}_set=yes;; *) eval ac_cv_prog_make_${ac_make}_set=no;; esac rm -f conftest.make fi if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } SET_MAKE= else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } SET_MAKE="MAKE=${MAKE-make}" fi #-------------------------------------------------------------------- # Determines the correct binary file extension (.o, .obj, .exe etc.) #-------------------------------------------------------------------- #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ # Check whether --with-encoding was given. if test ${with_encoding+y} then : withval=$with_encoding; with_tcencoding=${withval} fi if test x"${with_tcencoding}" != x ; then printf "%s\n" "#define TCL_CFGVAL_ENCODING \"${with_tcencoding}\"" >>confdefs.h else printf "%s\n" "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h fi #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5 printf %s "checking how to build libraries... " >&6; } # Check whether --enable-shared was given. if test ${enable_shared+y} then : enableval=$enable_shared; tcl_ok=$enableval else $as_nop tcl_ok=yes fi if test "$tcl_ok" = "yes" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared" >&5 printf "%s\n" "shared" >&6; } SHARED_BUILD=1 else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: static" >&5 printf "%s\n" "static" >&6; } SHARED_BUILD=0 printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- ac_header= ac_cache= for ac_item in $ac_header_c_list do if test $ac_cache; then ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default" if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then printf "%s\n" "#define $ac_item 1" >> confdefs.h fi ac_header= ac_cache= elif test $ac_header; then ac_cache=$ac_item else ac_header=$ac_item fi done if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes then : printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h fi # Step 0: Enable 64 bit support? { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5 printf %s "checking if 64bit support is requested... " >&6; } # Check whether --enable-64bit was given. if test ${enable_64bit+y} then : enableval=$enable_64bit; do64bit=$enableval else $as_nop do64bit=no fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 printf "%s\n" "$do64bit" >&6; } # Set some defaults (may get changed below) EXTRA_CFLAGS="" printf "%s\n" "#define MODULE_SCOPE extern" >>confdefs.h # Extract the first word of "cygpath", so it can be a program name with args. set dummy cygpath; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CYGPATH+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CYGPATH"; then ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CYGPATH="cygpath -m" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" fi fi CYGPATH=$ac_cv_prog_CYGPATH if test -n "$CYGPATH"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5 printf "%s\n" "$CYGPATH" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi # Extract the first word of "wine", so it can be a program name with args. set dummy wine; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_WINE+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$WINE"; then ac_cv_prog_WINE="$WINE" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_WINE="wine" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi WINE=$ac_cv_prog_WINE if test -n "$WINE"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5 printf "%s\n" "$WINE" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi SHLIB_SUFFIX=".dll" # MACHINE is IX86 for LINK, but this is used by the manifest, # which requires x86|amd64|ia64. MACHINE="X86" if test "$GCC" = "yes"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5 printf %s "checking for cross-compile version of gcc... " >&6; } if test ${ac_cv_cross+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef _WIN32 #error cross-compiler #endif int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_cross=no else $as_nop ac_cv_cross=yes 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_cross" >&5 printf "%s\n" "$ac_cv_cross" >&6; } if test "$ac_cv_cross" = "yes"; then case "$do64bit" in amd64|x64|yes) CC="x86_64-w64-mingw32-${CC}" LD="x86_64-w64-mingw32-ld" AR="x86_64-w64-mingw32-ar" |
︙ | ︙ | |||
3979 3980 3981 3982 3983 3984 3985 | if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then conftest=/tmp/conftest.rc echo "STRINGTABLE BEGIN" > $conftest echo "101 \"name\"" >> $conftest echo "END" >> $conftest | | | | | | | | | | | > | | | | > | | | | | | | > | | | | | > | | | | | > | | | | > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 | if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then conftest=/tmp/conftest.rc echo "STRINGTABLE BEGIN" > $conftest echo "101 \"name\"" >> $conftest echo "END" >> $conftest { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for Windows native path bug in windres" >&5 printf %s "checking for Windows native path bug in windres... " >&6; } cyg_conftest=`$CYGPATH $conftest` if { ac_try='$RC -o conftest.res.o $cyg_conftest' { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 (eval $ac_try) 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; } ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } CYGPATH=echo fi conftest= cyg_conftest= fi if test "$CYGPATH" = "echo"; then DEPARG='"$<"' else DEPARG='"$(shell $(CYGPATH) $<)"' fi # set various compiler flags depending on whether we are using gcc or cl if test "${GCC}" = "yes" ; then extra_cflags="-pipe" extra_ldflags="-pipe -static-libgcc" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for mingw32 version of gcc" >&5 printf %s "checking for mingw32 version of gcc... " >&6; } if test ${ac_cv_win32+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef _WIN32 #error win32 #endif int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_win32=no else $as_nop ac_cv_win32=yes 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_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 else $as_nop # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_link () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes || test -x conftest$ac_exeext } then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <windows.h> int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_municode=yes else $as_nop ac_cv_municode=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_municode" >&5 printf "%s\n" "$ac_cv_municode" >&6; } CFLAGS=$hold_cflags if test "$ac_cv_municode" = "yes" ; then extra_ldflags="$extra_ldflags -municode" else extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" fi { 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 /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_nolto=yes else $as_nop ac_cv_nolto=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_nolto" >&5 printf "%s\n" "$ac_cv_nolto" >&6; } CFLAGS=$hold_cflags if test "$ac_cv_nolto" = "yes" ; then CFLAGS_NOLTO="-fno-lto" else CFLAGS_NOLTO="" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -finput-charset" >&5 printf %s "checking if the compiler understands -finput-charset... " >&6; } if test ${tcl_cv_cc_input_charset+y} then : printf %s "(cached) " >&6 else $as_nop hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cc_input_charset=yes else $as_nop tcl_cv_cc_input_charset=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext CFLAGS=$hold_cflags 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 LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= RC_INCLUDE=--include RC_DEFINE=--define RES=res.o MAKE_LIB="\${STLIB_LD} \$@" MAKE_STUB_LIB="\${STLIB_LD} \$@" POST_MAKE_LIB="\${RANLIB} \$@" MAKE_EXE="\${CC} -o \$@" LIBPREFIX="lib" if test "${SHARED_BUILD}" = "0" ; then # static { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5 printf "%s\n" "using static flags" >&6; } runtime= LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s.exe" else # dynamic { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5 printf "%s\n" "using shared flags" >&6; } # ad-hoc check to see if CC supports -shared. if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then as_fn_error $? "${CC} does not support the -shared option. You will need to upgrade to a newer version of the toolchain." "$LINENO" 5 fi |
︙ | ︙ | |||
4199 4200 4201 4202 4203 4204 4205 | LDFLAGS_OPTIMIZE= case "${CC}" in *++) CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" ;; *) | | | 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 | LDFLAGS_OPTIMIZE= case "${CC}" in *++) CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" ;; *) CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -fextended-identifiers" ;; esac # Specify the CC output file names based on the target name CC_OBJNAME="-o \$@" CC_EXENAME="-o \$@" |
︙ | ︙ | |||
4227 4228 4229 4230 4231 4232 4233 | #LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}" LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}" LDFLAGS_WINDOW="-mwindows ${extra_ldflags}" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build | | | | | | | > | | | | | | | | | | | 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 | #LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}" LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}" LDFLAGS_WINDOW="-mwindows ${extra_ldflags}" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } ;; ia64) MACHINE="IA64" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } ;; *) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef _WIN64 #error 32-bit #endif int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_win_64bit=yes else $as_nop tcl_win_64bit=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext if test "$tcl_win_64bit" = "yes" ; then do64bit=amd64 MACHINE="AMD64" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } fi ;; esac else if test "${SHARED_BUILD}" = "0" ; then # static { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5 printf "%s\n" "using static flags" >&6; } runtime=-MT LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s.exe" else # dynamic { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5 printf "%s\n" "using shared flags" >&6; } runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. LIBRARIES="\${SHARED_LIBRARIES}" EXESUFFIX=".exe" case "x`echo \${VisualStudioVersion}`" in x1[4-9]*) lflags="${lflags} -nodefaultlib:libucrt.lib" |
︙ | ︙ | |||
4306 4307 4308 4309 4310 4311 4312 | amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build ;; ia64) MACHINE="IA64" ;; esac | | | | 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 | 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 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" |
︙ | ︙ | |||
4382 4383 4384 4385 4386 4387 4388 | else LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}" LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}" fi fi if test "$do64bit" != "no" ; then | | | | | > | | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > | | | | | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | > | < | | | > | | | | > | | | | | > | 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 | else LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}" LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}" fi fi if test "$do64bit" != "no" ; then printf "%s\n" "#define TCL_CFG_DO64BIT 1" >>confdefs.h fi if test "${GCC}" = "yes" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5 printf %s "checking for SEH support in compiler... " >&6; } if test ${tcl_cv_seh+y} then : printf %s "(cached) " >&6 else $as_nop if test "$cross_compiling" = yes then : tcl_cv_seh=no else $as_nop # ac_fn_c_try_run LINENO # ---------------------- # Try to run conftest.$ac_ext, and return whether this succeeded. Assumes that # executables *can* be run. ac_fn_c_try_run () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; } then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: program exited with status $ac_status" >&5 printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=$ac_status fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_run cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN int main(int argc, char** argv) { int a, b = 0; __try { a = 666 / b; } __except (EXCEPTION_EXECUTE_HANDLER) { return 0; } return 1; } _ACEOF if ac_fn_c_try_run "$LINENO" then : tcl_cv_seh=yes else $as_nop tcl_cv_seh=no fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ conftest.$ac_objext conftest.beam conftest.$ac_ext fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5 printf "%s\n" "$tcl_cv_seh" >&6; } if test "$tcl_cv_seh" = "no" ; then printf "%s\n" "#define HAVE_NO_SEH 1" >>confdefs.h fi # # Check to see if the excpt.h include file provided contains the # definition for EXCEPTION_DISPOSITION; if not, which is the case # with Cygwin's version as of 2002-04-10, define it to be int, # sufficient for getting the current code to work. # { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5 printf %s "checking for EXCEPTION_DISPOSITION support in include files... " >&6; } if test ${tcl_cv_eh_disposition+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ # define WIN32_LEAN_AND_MEAN # include <windows.h> # undef WIN32_LEAN_AND_MEAN int main (void) { EXCEPTION_DISPOSITION x; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_eh_disposition=yes else $as_nop tcl_cv_eh_disposition=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_eh_disposition" >&5 printf "%s\n" "$tcl_cv_eh_disposition" >&6; } if test "$tcl_cv_eh_disposition" = "no" ; then printf "%s\n" "#define EXCEPTION_DISPOSITION int" >>confdefs.h fi # Check to see if winnt.h defines CHAR, SHORT, and LONG # even if VOID has already been #defined. The win32api # used by mingw and cygwin is known to do this. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5 printf %s "checking for winnt.h that ignores VOID define... " >&6; } if test ${tcl_cv_winnt_ignore_void+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define VOID void #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN int main (void) { CHAR c; SHORT s; LONG l; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_winnt_ignore_void=yes else $as_nop tcl_cv_winnt_ignore_void=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_winnt_ignore_void" >&5 printf "%s\n" "$tcl_cv_winnt_ignore_void" >&6; } if test "$tcl_cv_winnt_ignore_void" = "yes" ; then printf "%s\n" "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h fi ac_fn_c_check_header_compile "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default" if test "x$ac_cv_header_stdbool_h" = xyes then : printf "%s\n" "#define HAVE_STDBOOL_H 1" >>confdefs.h fi # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5 printf %s "checking for cast to union support... " >&6; } if test ${tcl_cv_cast_to_union+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { union foo { int i; double d; }; union foo f = (union foo) (int) 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cast_to_union=yes else $as_nop tcl_cv_cast_to_union=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_cast_to_union" >&5 printf "%s\n" "$tcl_cv_cast_to_union" >&6; } if test "$tcl_cv_cast_to_union" = "yes"; then printf "%s\n" "#define HAVE_CAST_TO_UNION 1" >>confdefs.h fi fi # DL_LIBS is empty, but then we match the Unix version # Cross-compiling |
︙ | ︙ | |||
4594 4595 4596 4597 4598 4599 4600 | #------------------------------------------------------------------------ # Add stuff for zlib/libtommath; note that this is mostly done in the # makefile now as we just assume that the platform hasn't got usable # z.lib/tommath.lib #------------------------------------------------------------------------ | | > | | > | | > | | > | | | | | < | < | < | < < < < < | < < < < < < < | < < < < < < < < < < < < < < < < < < < < < | < < < < < > | < | < | < | < < < < < | < < < < < < < < | < < < | | < | < < < < < < < < < < < < < < < < < < < < < | > | | | | > | | | 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 | #------------------------------------------------------------------------ # Add stuff for zlib/libtommath; note that this is mostly done in the # makefile now as we just assume that the platform hasn't got usable # z.lib/tommath.lib #------------------------------------------------------------------------ if test "${enable_shared+set}" = "set" then : enableval="$enable_shared" tcl_ok=$enableval else $as_nop tcl_ok=yes fi if test "$tcl_ok" = "yes" then : ZLIB_DLL_FILE=\${ZLIB_DLL_FILE} TOMMATH_DLL_FILE=\${TOMMATH_DLL_FILE} printf "%s\n" "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h if test "$do64bit" != "no" then : printf "%s\n" "#define MP_64BIT 1" >>confdefs.h if test "$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 else $as_nop ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win32/tommath.lib fi else $as_nop ZLIB_OBJS=\${ZLIB_OBJS} TOMMATH_OBJS=\${TOMMATH_OBJS} fi printf "%s\n" "#define HAVE_ZLIB 1" >>confdefs.h ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" " #include <stdint.h> " if test "x$ac_cv_type_intptr_t" = xyes then : printf "%s\n" "#define HAVE_INTPTR_T 1" >>confdefs.h fi ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" " #include <stdint.h> " if test "x$ac_cv_type_uintptr_t" = xyes then : printf "%s\n" "#define HAVE_UINTPTR_T 1" >>confdefs.h fi #-------------------------------------------------------------------- # Zipfs support - Tip 430 #-------------------------------------------------------------------- # Check whether --enable-zipfs was given. if test ${enable_zipfs+y} then : enableval=$enable_zipfs; tcl_ok=$enableval else $as_nop tcl_ok=yes fi if test "$tcl_ok" = "yes" ; then # # Find a native compiler # # Put a plausible default for CC_FOR_BUILD in Makefile. if test -z "$CC_FOR_BUILD"; then if test "x$cross_compiling" = "xno"; then CC_FOR_BUILD='$(CC)' else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 printf %s "checking for gcc... " >&6; } if test ${ac_cv_path_cc+y} then : printf %s "(cached) " >&6 else $as_nop search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/gcc 2> /dev/null` \ `ls -r $dir/gcc 2> /dev/null` ; do if test x"$ac_cv_path_cc" = x ; then if test -f "$j" ; then |
︙ | ︙ | |||
4809 4810 4811 4812 4813 4814 4815 | # Also set EXEEXT_FOR_BUILD. if test "x$cross_compiling" = "xno"; then EXEEXT_FOR_BUILD='$(EXEEXT)' OBJEXT_FOR_BUILD='$(OBJEXT)' else OBJEXT_FOR_BUILD='.no' | | | | > | | | | | | | > | | | | | | | | | > | | | | | | | | | | | | < < < | < > | | < | | | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | | > | | | | > | | | | | | | | > | | | | | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | > | | > | | | | 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 | # Also set EXEEXT_FOR_BUILD. if test "x$cross_compiling" = "xno"; then EXEEXT_FOR_BUILD='$(EXEEXT)' OBJEXT_FOR_BUILD='$(OBJEXT)' else OBJEXT_FOR_BUILD='.no' { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 printf %s "checking for build system executable suffix... " >&6; } if test ${bfd_cv_build_exeext+y} then : printf %s "(cached) " >&6 else $as_nop rm -f conftest* echo 'int main () { return 0; }' > conftest.c bfd_cv_build_exeext= ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 for file in conftest.*; do case $file in *.c | *.o | *.obj | *.ilk | *.pdb) ;; *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; esac done rm -f conftest* test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 printf "%s\n" "$bfd_cv_build_exeext" >&6; } EXEEXT_FOR_BUILD="" test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} fi # # Find a native zip implementation # { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 printf %s "checking for tclsh... " >&6; } if test ${ac_cv_path_tclsh+y} then : printf %s "(cached) " >&6 else $as_nop search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done fi if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5 printf "%s\n" "$TCLSH_PROG" >&6; } else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5 printf "%s\n" "No tclsh found on PATH" >&6; } fi ZIP_PROG="" ZIP_PROG_OPTIONS="" ZIP_PROG_VFSSEARCH="" ZIP_INSTALL_OBJS="" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 printf %s "checking for zip... " >&6; } if test ${ac_cv_path_zip+y} then : printf %s "(cached) " >&6 else $as_nop search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/zip 2> /dev/null` \ `ls -r $dir/zip 2> /dev/null` ; do if test x"$ac_cv_path_zip" = x ; then if test -f "$j" ; then ac_cv_path_zip=$j break fi fi done done fi if test -f "$ac_cv_path_zip" ; then ZIP_PROG="$ac_cv_path_zip" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 printf "%s\n" "$ZIP_PROG" >&6; } ZIP_PROG_OPTIONS="-rq" ZIP_PROG_VFSSEARCH="*" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5 printf "%s\n" "Found INFO Zip in environment" >&6; } # Use standard arguments for zip else # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}" ZIP_PROG_OPTIONS="-o -r" ZIP_PROG_VFSSEARCH="*" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 printf "%s\n" "No zip found on PATH building minizip" >&6; } fi ZIPFS_BUILD=1 TCL_ZIP_FILE=libtcl${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_PATCH_LEVEL}.zip else ZIPFS_BUILD=0 TCL_ZIP_FILE= fi # Do checking message here to not mess up interleaved configure output { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 printf %s "checking for building with zipfs... " >&6; } if test "${ZIPFS_BUILD}" = 1; then if test "${SHARED_BUILD}" = 0; then ZIPFS_BUILD=2; printf "%s\n" "#define ZIPFS_BUILD 2" >>confdefs.h else printf "%s\n" "#define ZIPFS_BUILD 1" >>confdefs.h \ fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } INSTALL_LIBRARIES=install-libraries INSTALL_MSGS=install-msgs fi #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } if test ${tcl_cv_findex_enums+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN int main (void) { FINDEX_INFO_LEVELS i; FINDEX_SEARCH_OPS j; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_findex_enums=yes else $as_nop tcl_cv_findex_enums=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_findex_enums" >&5 printf "%s\n" "$tcl_cv_findex_enums" >&6; } if test "$tcl_cv_findex_enums" = "no"; then printf "%s\n" "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h fi # See if the compiler supports intrinsics. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for intrinsics support in compiler" >&5 printf %s "checking for intrinsics support in compiler... " >&6; } if test ${tcl_cv_intrinsics+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN #include <intrin.h> int main (void) { __cpuidex(0,0,0); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_intrinsics=yes else $as_nop tcl_cv_intrinsics=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intrinsics" >&5 printf "%s\n" "$tcl_cv_intrinsics" >&6; } if test "$tcl_cv_intrinsics" = "yes"; then printf "%s\n" "#define HAVE_INTRIN_H 1" >>confdefs.h fi # See if the <wspiapi.h> header file is present { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for wspiapi.h" >&5 printf %s "checking for wspiapi.h... " >&6; } if test ${tcl_cv_wspiapi_h+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <wspiapi.h> int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_wspiapi_h=yes else $as_nop tcl_cv_wspiapi_h=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_wspiapi_h" >&5 printf "%s\n" "$tcl_cv_wspiapi_h" >&6; } if test "$tcl_cv_wspiapi_h" = "yes"; then printf "%s\n" "#define HAVE_WSPIAPI_H 1" >>confdefs.h fi # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } if test ${tcl_cv_findex_enums+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN int main (void) { FINDEX_INFO_LEVELS i; FINDEX_SEARCH_OPS j; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_findex_enums=yes else $as_nop tcl_cv_findex_enums=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_findex_enums" >&5 printf "%s\n" "$tcl_cv_findex_enums" >&6; } if test "$tcl_cv_findex_enums" = "no"; then printf "%s\n" "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h fi #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols # option. This macro depends on C flags, and should be called # after SC_CONFIG_CFLAGS macro is called. #-------------------------------------------------------------------- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5 printf %s "checking for build with symbols... " >&6; } # Check whether --enable-symbols was given. if test ${enable_symbols+y} then : enableval=$enable_symbols; tcl_ok=$enableval else $as_nop tcl_ok=no fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' printf "%s\n" "#define NDEBUG 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } printf "%s\n" "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' if test "$tcl_ok" = "yes"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5 printf "%s\n" "yes (standard debugging)" >&6; } fi fi if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then printf "%s\n" "#define TCL_MEM_DEBUG 1" >>confdefs.h fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then printf "%s\n" "#define TCL_COMPILE_DEBUG 1" >>confdefs.h printf "%s\n" "#define TCL_COMPILE_STATS 1" >>confdefs.h fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5 printf "%s\n" "enabled symbols mem compile debugging" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5 printf "%s\n" "enabled $tcl_ok debugging" >&6; } fi fi #-------------------------------------------------------------------- # Embed the manifest if we can determine how #-------------------------------------------------------------------- ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 printf %s "checking how to run the C preprocessor... " >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test ${ac_cv_prog_CPP+y} then : printf %s "(cached) " >&6 else $as_nop # Double quotes because $CC needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" cpp /lib/cpp do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <limits.h> Syntax error _ACEOF if ac_fn_c_try_cpp "$LINENO" then : else $as_nop # Broken: fails on valid input. continue fi rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <ac_nonexistent.h> _ACEOF if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue else $as_nop # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 printf "%s\n" "$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <limits.h> Syntax error _ACEOF if ac_fn_c_try_cpp "$LINENO" then : else $as_nop # Broken: fails on valid input. continue fi rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <ac_nonexistent.h> _ACEOF if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue else $as_nop # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : else $as_nop { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 printf %s "checking for grep that handles long lines and -e... " >&6; } if test ${ac_cv_path_GREP+y} then : printf %s "(cached) " >&6 else $as_nop if test -z "$GREP"; then ac_path_GREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_prog in grep ggrep do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir$ac_prog$ac_exec_ext" as_fn_executable_p "$ac_path_GREP" || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in *GNU*) ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; *) ac_count=0 printf %s 0123456789 >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" printf "%s\n" 'GREP' >> "conftest.nl" "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val if test $ac_count -gt ${ac_path_GREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_GREP_found && break 3 done done done IFS=$as_save_IFS if test -z "$ac_cv_path_GREP"; then as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_GREP=$GREP fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 printf "%s\n" "$ac_cv_path_GREP" >&6; } GREP="$ac_cv_path_GREP" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 printf %s "checking for egrep... " >&6; } if test ${ac_cv_path_EGREP+y} then : printf %s "(cached) " >&6 else $as_nop if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 then ac_cv_path_EGREP="$GREP -E" else if test -z "$EGREP"; then ac_path_EGREP_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_prog in egrep do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir$ac_prog$ac_exec_ext" as_fn_executable_p "$ac_path_EGREP" || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in *GNU*) ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; *) ac_count=0 printf %s 0123456789 >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" printf "%s\n" 'EGREP' >> "conftest.nl" "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val if test $ac_count -gt ${ac_path_EGREP_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_found && break 3 done done done IFS=$as_save_IFS if test -z "$ac_cv_path_EGREP"; then as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_EGREP=$EGREP fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 printf "%s\n" "$ac_cv_path_EGREP" >&6; } EGREP="$ac_cv_path_EGREP" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5 printf %s "checking whether to embed manifest... " >&6; } # Check whether --enable-embedded-manifest was given. if test ${enable_embedded_manifest+y} then : enableval=$enable_embedded_manifest; embed_ok=$enableval else $as_nop embed_ok=yes fi VC_MANIFEST_EMBED_DLL= VC_MANIFEST_EMBED_EXE= result=no if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \ -a "$GCC" != "yes" ; then # Add the magic to embed the manifest into the dll/exe cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #if defined(_MSC_VER) && _MSC_VER >= 1400 print("manifest needed") #endif _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "manifest needed" >/dev/null 2>&1 then : # Could do a CHECK_PROG for mt, but should always be with MSVC8+ # Could add 'if test -f' check, but manifest should be created # in this compiler case # Add in a manifest argument that may be specified # XXX Needs improvement so that the test for existence accounts # XXX for a provided (known) manifest VC_MANIFEST_EMBED_DLL="if test -f \[email protected] ; then mt.exe -nologo -manifest \[email protected] -outputresource:\$@\;2 ; fi" VC_MANIFEST_EMBED_EXE="if test -f \[email protected] ; then mt.exe -nologo -manifest \[email protected] -outputresource:\$@\;1 ; fi" result=yes if test "x" != x ; then result="yes ()" fi fi rm -rf conftest* fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $result" >&5 printf "%s\n" "$result" >&6; } #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name #------------------------------------------------------------------------ |
︙ | ︙ | |||
5270 5271 5272 5273 5274 5275 5276 | eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" | | | 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 | eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" else eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\"" fi eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\"" eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\"" |
︙ | ︙ | |||
5420 5421 5422 5423 5424 5425 5426 |
| | | 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 | ac_config_files="$ac_config_files Makefile tclConfig.sh tclsh.exe.manifest" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. |
︙ | ︙ | |||
5449 5450 5451 5452 5453 5454 5455 | # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( | | | | 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 | # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac |
︙ | ︙ | |||
5480 5481 5482 5483 5484 5485 5486 | esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear | | | | | | | 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 | esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then if test "x$cache_file" != "x/dev/null"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 printf "%s\n" "$as_me: updating cache $cache_file" >&6;} if test ! -f "$cache_file" || test -h "$cache_file"; then cat confcache >"$cache_file" else case $cache_file in #( */* | ?:*) mv -f confcache "$cache_file"$$ && mv -f "$cache_file"$$ "$cache_file" ;; #( *) mv -f confcache "$cache_file" ;; esac fi fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' |
︙ | ︙ | |||
5556 5557 5558 5559 5560 5561 5562 | ac_libobjs= ac_ltlibobjs= U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' | | | | | 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 | ac_libobjs= ac_ltlibobjs= U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} as_write_fail=0 cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. |
︙ | ︙ | |||
5596 5597 5598 5599 5600 5601 5602 | cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh | > | > | > > > > > > > > < < < < < < < < | | < | | < < < < < < | < < < < < < < | > > | < < > | | > > > > > > > > > | > > > > | < < < < < < < > | > > > | | < < < < < < < < < < < < < < < < < < < < | | > | 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 | cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else $as_nop case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { |
︙ | ︙ | |||
5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 | # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. | > | > | | > | | 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 | # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else $as_nop as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else $as_nop as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith |
︙ | ︙ | |||
5817 5818 5819 5820 5821 5822 5823 | as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || | | | 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 | as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q |
︙ | ︙ | |||
5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 | # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null | > > > > > > > > > > | 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 | # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null |
︙ | ︙ | |||
5893 5894 5895 5896 5897 5898 5899 | case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( | | | | 6353 6354 6355 6356 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 | case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q |
︙ | ︙ | |||
5964 5965 5966 5967 5968 5969 5970 | test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" | | | | 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 | test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by tcl $as_me 9.0, which was generated by GNU Autoconf 2.70. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ |
︙ | ︙ | |||
6014 6015 6016 6017 6018 6019 6020 6021 | Configuration files: $config_files Report bugs to the package provider." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 | > > | | | | | 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 | Configuration files: $config_files Report bugs to the package provider." _ACEOF ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.70, with options \\"\$ac_cs_config\\" Copyright (C) 2020 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 |
︙ | ︙ | |||
6058 6059 6060 6061 6062 6063 6064 | esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) | | | | | | 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 | esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) printf "%s\n" "$ac_cs_version"; exit ;; --config | --confi | --conf | --con | --co | --c ) printf "%s\n" "$ac_cs_config"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; --he | --h | --help | --hel | -h ) printf "%s\n" "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) as_fn_error $? "unrecognized option: \`$1' Try \`$0 --help' for more information." ;; |
︙ | ︙ | |||
6100 6101 6102 6103 6104 6105 6106 | fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift | | | < | | 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 6578 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 6617 | fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' export CONFIG_SHELL exec "\$@" fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX printf "%s\n" "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; "tclsh.exe.manifest") CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: |
︙ | ︙ | |||
6370 6371 6372 6373 6374 6375 6376 | test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac | | | | | | | | 6831 6832 6833 6834 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845 6846 6847 6848 6849 6850 6851 6852 6853 6854 6855 6856 6857 6858 6859 6860 6861 6862 6863 6864 6865 6866 6867 6868 6869 6870 6871 6872 6873 6874 6875 6876 6877 6878 6879 6880 | test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 printf "%s\n" "$as_me: creating $ac_file" >&6;} fi # Neutralize special characters interpreted by sed in replacement strings. case $configure_input in #( *\&* | *\|* | *\\* ) ac_sed_conf_input=`printf "%s\n" "$configure_input" | sed 's/[\\\\&|]/\\\\&/g'`;; #( *) ac_sed_conf_input=$configure_input;; esac case $ac_tag in *:-:* | *:-) cat >"$ac_tmp/stdin" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q |
︙ | ︙ | |||
6429 6430 6431 6432 6433 6434 6435 | s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) | | | | 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 | s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix |
︙ | ︙ | |||
6484 6485 6486 6487 6488 6489 6490 | /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) | | | | 6945 6946 6947 6948 6949 6950 6951 6952 6953 6954 6955 6956 6957 6958 6959 6960 | /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g |
︙ | ︙ | |||
6527 6528 6529 6530 6531 6532 6533 | eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && | | | | 6988 6989 6990 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 | eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&5 printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" case $ac_file in -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ |
︙ | ︙ | |||
6576 6577 6578 6579 6580 6581 6582 | $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then | | | > | 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046 7047 7048 7049 | $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi |
Changes to win/configure.ac.
1 2 3 4 5 | #! /bin/bash -norc # This file is an input file used by the GNU "autoconf" program to # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. | > | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | #! /bin/bash -norc # This file is an input file used by the GNU "autoconf" program to # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. AC_INIT([tcl],[9.0]) AC_CONFIG_SRCDIR([../generic/tcl.h]) AC_PREREQ([2.69]) # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=9.0 |
︙ | ︙ | |||
55 56 57 58 59 60 61 | # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi AC_PROG_CC AC_C_INLINE | < | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi AC_PROG_CC AC_C_INLINE AC_CHECK_TOOL(AR, ar) AC_CHECK_TOOL(RANLIB, ranlib) AC_CHECK_TOOL(RC, windres) #-------------------------------------------------------------------- # Checks to see if the make program sets the $MAKE variable. |
︙ | ︙ | |||
140 141 142 143 144 145 146 | ]) ], [ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) | | < < < < < < < < < < < < < < | < < < < < < < < < < < < < < | < | | < < < < > | 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 | ]) ], [ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) AC_CHECK_TYPES([intptr_t, uintptr_t],,,[[ #include <stdint.h> ]]) #-------------------------------------------------------------------- # Zipfs support - Tip 430 #-------------------------------------------------------------------- AC_ARG_ENABLE(zipfs, AS_HELP_STRING([--enable-zipfs], [build with Zipfs support (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes" ; then # # Find a native compiler # AX_CC_FOR_BUILD # # Find a native zip implementation # SC_PROG_TCLSH SC_ZIPFS_SUPPORT ZIPFS_BUILD=1 TCL_ZIP_FILE=libtcl${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_PATCH_LEVEL}.zip else ZIPFS_BUILD=0 TCL_ZIP_FILE= fi # Do checking message here to not mess up interleaved configure output AC_MSG_CHECKING([for building with zipfs]) if test "${ZIPFS_BUILD}" = 1; then if test "${SHARED_BUILD}" = 0; then ZIPFS_BUILD=2; AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) else AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ fi AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) INSTALL_LIBRARIES=install-libraries INSTALL_MSGS=install-msgs fi AC_SUBST(ZIPFS_BUILD) AC_SUBST(TCL_ZIP_FILE) |
︙ | ︙ | |||
230 231 232 233 234 235 236 | # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h, tcl_cv_findex_enums, | | | < | | | | | < | | | | | | | | | < | | | | 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 | # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h, tcl_cv_findex_enums, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN ]], [[ FINDEX_INFO_LEVELS i; FINDEX_SEARCH_OPS j; ]])], [tcl_cv_findex_enums=yes], [tcl_cv_findex_enums=no]) ) if test "$tcl_cv_findex_enums" = "no"; then AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1, [Defined when enums are missing from winbase.h]) fi # See if the compiler supports intrinsics. AC_CACHE_CHECK(for intrinsics support in compiler, tcl_cv_intrinsics, AC_LINK_IFELSE([AC_LANG_PROGRAM([[ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN #include <intrin.h> ]], [[ __cpuidex(0,0,0); ]])], [tcl_cv_intrinsics=yes], [tcl_cv_intrinsics=no]) ) if test "$tcl_cv_intrinsics" = "yes"; then AC_DEFINE(HAVE_INTRIN_H, 1, [Defined when the compilers supports intrinsics]) fi # See if the <wspiapi.h> header file is present AC_CACHE_CHECK(for wspiapi.h, tcl_cv_wspiapi_h, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <wspiapi.h> ]], [[]])], [tcl_cv_wspiapi_h=yes], [tcl_cv_wspiapi_h=no]) ) if test "$tcl_cv_wspiapi_h" = "yes"; then AC_DEFINE(HAVE_WSPIAPI_H, 1, [Defined when wspiapi.h exists]) fi # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h, tcl_cv_findex_enums, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN ]], [[ FINDEX_INFO_LEVELS i; FINDEX_SEARCH_OPS j; ]])], [tcl_cv_findex_enums=yes], [tcl_cv_findex_enums=no]) ) if test "$tcl_cv_findex_enums" = "no"; then AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1, [Defined when enums are missing from winbase.h]) fi #-------------------------------------------------------------------- |
︙ | ︙ | |||
341 342 343 344 345 346 347 | eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" | | | 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 | eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" else eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\"" fi eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\"" eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\"" |
︙ | ︙ | |||
491 492 493 494 495 496 497 | AC_SUBST(RC_OUT) AC_SUBST(RC_TYPE) AC_SUBST(RC_INCLUDE) AC_SUBST(RC_DEFINE) AC_SUBST(RC_DEFINES) AC_SUBST(RES) | | > | | 456 457 458 459 460 461 462 463 464 465 466 467 468 | AC_SUBST(RC_OUT) AC_SUBST(RC_TYPE) AC_SUBST(RC_INCLUDE) AC_SUBST(RC_DEFINE) AC_SUBST(RC_DEFINES) AC_SUBST(RES) AC_CONFIG_FILES([Makefile tclConfig.sh tclsh.exe.manifest]) AC_OUTPUT dnl Local Variables: dnl mode: autoconf dnl End: |
Changes to win/makefile.vc.
︙ | ︙ | |||
12 13 14 15 16 17 18 | # Copyright (c) 2003-2008 Pat Thoyts. # Copyright (c) 2017 Ashok P. Nadkarni #------------------------------------------------------------------------------ # General usage: # nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]] # | | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | # Copyright (c) 2003-2008 Pat Thoyts. # Copyright (c) 2017 Ashok P. Nadkarni #------------------------------------------------------------------------------ # General usage: # nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]] # # For MACRODEF, see TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) # or examine Sections 6-8 in rules.vc. # # Possible values of TARGET are: # release -- Builds the core, the shell and the dlls. (default) # dlls -- Just builds the windows extensions # shell -- Just builds the shell and the core. # core -- Only builds the core [tclXX.(dll|lib)]. |
︙ | ︙ | |||
48 49 50 51 52 53 54 | # # NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform # SDK (not expressly needed), run setenv.bat after # vcvars32.bat according to the instructions for it. This can also # turn on the 64-bit compiler, if your SDK has it. # # Basic macros and options usable on the commandline (see rules.vc for more info): | | > > > > > | | | > | | | < | < | | 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 | # # NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform # SDK (not expressly needed), run setenv.bat after # vcvars32.bat according to the instructions for it. This can also # turn on the 64-bit compiler, if your SDK has it. # # Basic macros and options usable on the commandline (see rules.vc for more info): # OPTS=nomsvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,unchecked,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. # profile = Adds profiling hooks. Map file is assumed. # static = Builds a static library of the core instead of a # dll. The shell will be static (and large), and # have the dde and registry extensions linked inside. # symbols = Adds symbols for step debugging. # thrdalloc = Use the thread allocator (shared global free pool). # unchecked = Allows a symbols build to not use the debug # enabled runtime (msvcrt.dll not msvcrtd.dll # or libcmt.lib not libcmtd.lib). # # STATS=compdbg,memdbg,none # Sets optional memory and bytecode compiler debugging code added |
︙ | ︙ | |||
136 137 138 139 140 141 142 143 144 145 146 147 148 149 | # The rules.vc file does most of the hard work in terms of defining # the build configuration, macros, output directories etc. !include "rules.vc" # Tcl version info based on macros set up by rules.vc DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) # We need versions of various core packages to generate appropriate # file names during installation. !if [echo REM = This file is generated from makefile.vc > versions.vc] !endif !if [echo PKG_HTTP_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc] | > > > > > > > > > > > > > > > > > > > > > | 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 | # The rules.vc file does most of the hard work in terms of defining # the build configuration, macros, output directories etc. !include "rules.vc" # Tcl version info based on macros set up by rules.vc DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) # The staticpkg option is not longer supported in Tcl 8.7 # though extensions may still be using it. If specified together # with "static", ignore it as that is now the default for # static build. For non-static builds, no longer supported # now (was permitted in 8.6) !if $(TCL_USE_STATIC_PACKAGES) !if $(STATIC_BUILD) !message *** NOTE: The "staticpkg" option redundant in 8.7. !else !message *** NOTE: The "staticpkg" option ignored for shared library builds. !endif !endif !if [nmakehlp -f $(OPTS) "noembed"] !message *** Option noembed specified. Tcl script library will not be appended to the binary. TCL_EMBED_SCRIPTS = 0 !else !message *** Tcl script library will be appended to the binary. TCL_EMBED_SCRIPTS = 1 !endif # We need versions of various core packages to generate appropriate # file names during installation. !if [echo REM = This file is generated from makefile.vc > versions.vc] !endif !if [echo PKG_HTTP_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc] |
︙ | ︙ | |||
166 167 168 169 170 171 172 | !if [echo PKG_SHELL_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc] !endif !if [echo PKG_DDE_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc] !endif !if [echo PKG_REG_VER =\>> versions.vc] \ | | | | < < < < < < < < < < | 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 | !if [echo PKG_SHELL_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc] !endif !if [echo PKG_DDE_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc] !endif !if [echo PKG_REG_VER =\>> versions.vc] \ && [nmakehlp -V ..\library\registry\pkgIndex.tcl "registry " >> versions.vc] !endif !include versions.vc DDEDOTVERSION = 1.4 DDEVERSION = $(DDEDOTVERSION:.=) REGDOTVERSION = 1.3 REGVERSION = $(REGDOTVERSION:.=) TCLREGLIBNAME = $(PROJECT)9registry$(REGVERSION)$(SUFX:t=).$(EXT) TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME) TCLDDELIBNAME = $(PROJECT)9dde$(DDEVERSION)$(SUFX:t=).$(EXT) TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME) TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe TCLSHOBJS = \ $(TMP_DIR)\tclAppInit.obj \ $(TMP_DIR)\tclsh.res TCLTESTOBJS = \ $(TMP_DIR)\tclTest.obj \ $(TMP_DIR)\tclTestObj.obj \ $(TMP_DIR)\tclTestProcBodyObj.obj \ $(TMP_DIR)\tclThreadTest.obj \ $(TMP_DIR)\tclWinTest.obj \ !if !$(STATIC_BUILD) $(OUT_DIR)\tommath.lib \ !endif $(TMP_DIR)\testMain.obj COREOBJS = \ $(TMP_DIR)\regcomp.obj \ $(TMP_DIR)\regerror.obj \ |
︙ | ︙ | |||
371 372 373 374 375 376 377 378 379 380 381 382 383 384 | $(TMP_DIR)\bn_mp_sqrt.obj \ $(TMP_DIR)\bn_mp_sub.obj \ $(TMP_DIR)\bn_mp_sub_d.obj \ $(TMP_DIR)\bn_mp_signed_rsh.obj \ $(TMP_DIR)\bn_mp_to_ubin.obj \ $(TMP_DIR)\bn_mp_to_radix.obj \ $(TMP_DIR)\bn_mp_ubin_size.obj \ $(TMP_DIR)\bn_mp_xor.obj \ $(TMP_DIR)\bn_mp_zero.obj \ $(TMP_DIR)\bn_s_mp_add.obj \ $(TMP_DIR)\bn_s_mp_balance_mul.obj \ $(TMP_DIR)\bn_s_mp_karatsuba_mul.obj \ $(TMP_DIR)\bn_s_mp_karatsuba_sqr.obj \ $(TMP_DIR)\bn_s_mp_mul_digs.obj \ | > | 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 | $(TMP_DIR)\bn_mp_sqrt.obj \ $(TMP_DIR)\bn_mp_sub.obj \ $(TMP_DIR)\bn_mp_sub_d.obj \ $(TMP_DIR)\bn_mp_signed_rsh.obj \ $(TMP_DIR)\bn_mp_to_ubin.obj \ $(TMP_DIR)\bn_mp_to_radix.obj \ $(TMP_DIR)\bn_mp_ubin_size.obj \ $(TMP_DIR)\bn_mp_unpack.obj \ $(TMP_DIR)\bn_mp_xor.obj \ $(TMP_DIR)\bn_mp_zero.obj \ $(TMP_DIR)\bn_s_mp_add.obj \ $(TMP_DIR)\bn_s_mp_balance_mul.obj \ $(TMP_DIR)\bn_s_mp_karatsuba_mul.obj \ $(TMP_DIR)\bn_s_mp_karatsuba_sqr.obj \ $(TMP_DIR)\bn_s_mp_mul_digs.obj \ |
︙ | ︙ | |||
415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 | $(TMP_DIR)\tcl.res !endif TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ $(TMP_DIR)\tclOOStubLib.obj \ $(TMP_DIR)\tclWinPanic.obj ### The following paths CANNOT have spaces in them as they appear on ### the left side of implicit rules. TOMMATHDIR = $(ROOT)\libtommath PKGSDIR = $(ROOT)\pkgs # Additional include and C macro definitions for the implicit rules # defined in rules.vc PRJ_INCLUDES = -I"$(TOMMATHDIR)" PRJ_DEFINES = /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS # Additional Link libraries needed beyond those in rules.vc | > > > > | 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 | $(TMP_DIR)\tcl.res !endif TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ $(TMP_DIR)\tclStubCall.obj \ $(TMP_DIR)\tclStubLibTbl.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ $(TMP_DIR)\tclOOStubLib.obj \ $(TMP_DIR)\tclWinPanic.obj ### The following paths CANNOT have spaces in them as they appear on ### the left side of implicit rules. TOMMATHDIR = $(ROOT)\libtommath PKGSDIR = $(ROOT)\pkgs LIBTCLVFS = $(OUT_DIR)\libtcl.vfs # Additional include and C macro definitions for the implicit rules # defined in rules.vc PRJ_INCLUDES = -I"$(TOMMATHDIR)" PRJ_DEFINES = /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS # Additional Link libraries needed beyond those in rules.vc |
︙ | ︙ | |||
445 446 447 448 449 450 451 | !endif #--------------------------------------------------------------------- # Project specific targets #--------------------------------------------------------------------- | | > | > > > > > > > > > | | | 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 | !endif #--------------------------------------------------------------------- # Project specific targets #--------------------------------------------------------------------- release: setup $(TCLSH) $(TCLSTUBLIB) dlls libtclzip embed pkgs core: setup $(TCLLIB) $(TCLSTUBLIB) shell: setup $(TCLSH) dlls: setup $(TCLREGLIB) $(TCLDDELIB) $(OUT_DIR)\zlib1.dll $(OUT_DIR)\libtommath.dll libtclzip: core dlls $(TCLSCRIPTZIP) all: setup $(TCLSH) $(TCLSTUBLIB) dlls libtclzip embed pkgs embed: setup $(TCLSH) $(TCLSTUBLIB) libtclzip !if $(TCL_EMBED_SCRIPTS) !if $(STATIC_BUILD) @copy /y /b "$(TCLSH)"+"$(TCLSCRIPTZIP)" "$(TCLSH)" !else @copy /y /b "$(TCLLIB)"+"$(TCLSCRIPTZIP)" "$(TCLLIB)" !endif !endif tcltest: setup $(TCLTEST) dlls install: install-binaries install-libraries install-docs install-pkgs !if $(SYMBOLS) install: install-pdbs !endif setup: default-setup test: test-core test-pkgs test-core: setup $(TCLTEST) dlls set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << package ifneeded dde 1.4.4 [list load "$(TCLDDELIB:\=/)"] package ifneeded registry 1.3.6 [list load "$(TCLREGLIB:\=/)"] << runtest: setup $(TCLTEST) dlls set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLTEST) $(SCRIPT) runshell: setup $(TCLSH) dlls |
︙ | ︙ | |||
541 542 543 544 545 546 547 548 549 550 551 552 553 554 | $(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 !endif pkgs: @for /d %d in ($(PKGSDIR)\*) do \ @if exist "%~fd\win\makefile.vc" ( \ pushd "%~fd\win" & \ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\ popd \ | > > > > > > > > > > > > > > > > > > > > | 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 | $(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 !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) 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) &\ popd \ |
︙ | ︙ | |||
588 589 590 591 592 593 594 | !else $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \ $(GENERICDIR:\=/)/tclTomMath.decls $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ $(GENERICDIR:\=/)/tclOO.decls !endif | < | 638 639 640 641 642 643 644 645 646 647 648 649 650 651 | !else $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \ $(GENERICDIR:\=/)/tclTomMath.decls $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ $(GENERICDIR:\=/)/tclOO.decls !endif #--------------------------------------------------------------------- # Build the Windows HTML help file. #--------------------------------------------------------------------- # NOTE: you can define HHC on the command-line to override this. # nmake does not set macro values if already set on the command line. |
︙ | ︙ | |||
738 739 740 741 742 743 744 | #--------------------------------------------------------------------- # Special case object file targets #--------------------------------------------------------------------- $(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(appcflags) /DTCL_TEST /DUNICODE /D_UNICODE \ | < > | > > > > > > > > > > > > > > | < < | | > > > > > > > > > | 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 | #--------------------------------------------------------------------- # Special case object file targets #--------------------------------------------------------------------- $(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(appcflags) /DTCL_TEST /DUNICODE /D_UNICODE \ -Fo$@ $? $(TMP_DIR)\tclMainW.obj: $(GENERICDIR)\tclMain.c $(cc32) $(pkgcflags) /DUNICODE /D_UNICODE \ -Fo$@ $? $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(CCAPPCMD) $? $(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c $(cc32) $(pkgcflags) \ -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip \ -Fo$@ $? $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c $(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $? # Following the lead of the autoconf based make, we define the # CFG_RUNTIME_*DIR flags specifically for tclPkgConfig # and not as part of the global defines. These are all defined # as empty strings because they are intended to represent paths # at *runtime*, not build time. This may make sense on Unix systems # where end-user does configure and make on the target system. It # makes no sense on Windows where binary distributions may be installed # anywhere. Storing build time paths as runtime paths is misleading # at best and inefficient at worst as the code goes looking for # files and directories that do not exist. # Note: the same is true for the other CFG_RUNTIME* and CFG_INSTALL* # settings as well but they are historical and I do not want to change # them. $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c $(cc32) $(pkgcflags) \ /DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ /DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ /DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ /DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ /DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ /DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ -Fo$@ $? $(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(appcflags) /DUNICODE /D_UNICODE \ -Fo$@ $? ### The following objects should be built using the stub interfaces $(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $? $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $? ### The following objects are part of the stub library and should not ### be built as DLL objects. -Zl is used to avoid a dependency on any ### specific C run-time. $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclStubCall.obj: $(GENERICDIR)\tclStubCall.c $(cc32) $(stubscflags) \ /DCFG_RUNTIME_DLLFILE="\"$(TCLLIBNAME)\"" \ /DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ $(TCL_INCLUDES) -Fo$@ $? $(TMP_DIR)\tclStubLibTbl.obj: $(GENERICDIR)\tclStubLibTbl.c $(cc32) $(stubscflags) $(TCL_INCLUDES) -Fo$@ $? $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(stubscflags) -Fo$@ $? |
︙ | ︙ | |||
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 | @$(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)\" @echo Installing library files to $(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)\" @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(WIN_DIR)\tclooConfig.sh" "$(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) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\" @echo Installing package cookiejar $(PKG_COOKIEJAR_VER) @$(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) @$(CPY) "$(ROOT)\library\opt\*.tcl" \ | > > > > | 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 | @$(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) @$(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) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\" !if !$(TCL_EMBED_SCRIPTS) @echo Installing package cookiejar $(PKG_COOKIEJAR_VER) @$(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) @$(CPY) "$(ROOT)\library\opt\*.tcl" \ |
︙ | ︙ | |||
949 950 951 952 953 954 955 956 | "$(MODULE_INSTALL_DIR)\9.0\tcltest-$(PKG_TCLTEST_VER).tm" @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\platform.tcl" \ "$(MODULE_INSTALL_DIR)\9.0\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)\9.0\platform\shell-$(PKG_SHELL_VER).tm" @echo Installing $(TCLDDELIBNAME) | > | < < < < | < < < < | | | > > > > > > | 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 | "$(MODULE_INSTALL_DIR)\9.0\tcltest-$(PKG_TCLTEST_VER).tm" @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\platform.tcl" \ "$(MODULE_INSTALL_DIR)\9.0\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)\9.0\platform\shell-$(PKG_SHELL_VER).tm" !endif @echo Installing $(TCLDDELIBNAME) !if !$(STATIC_BUILD) @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" @$(CPY) "$(ROOT)\library\dde\pkgIndex.tcl" \ "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" !endif @echo Installing $(TCLREGLIBNAME) !if !$(STATIC_BUILD) @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\registry$(REGDOTVERSION)\" @$(CPY) "$(ROOT)\library\registry\pkgIndex.tcl" \ "$(LIB_INSTALL_DIR)\registry$(REGDOTVERSION)\" !endif !if !$(TCL_EMBED_SCRIPTS) @echo Installing encodings @$(CPY) "$(ROOT)\library\encoding\*.enc" \ "$(SCRIPT_INSTALL_DIR)\encoding\" !endif # "emacs font-lock highlighting fix install-tzdata: !if !$(TCL_EMBED_SCRIPTS) @echo Installing time zone data @set TCL_LIBRARY=$(ROOT:\=/)/library @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" !endif install-msgs: !if !$(TCL_EMBED_SCRIPTS) @echo Installing message catalogs @set TCL_LIBRARY=$(ROOT:\=/)/library @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" !endif install-pdbs: @echo Installing debug symbols @$(CPY) "$(OUT_DIR)\*.pdb" "$(BIN_INSTALL_DIR)\" # "emacs font-lock highlighting fix #--------------------------------------------------------------------- |
︙ | ︙ | |||
1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 | @if exist $(TCLDDELIB) del $(TCLDDELIB) @echo Removing $(TCLREGLIB) ... @if exist $(TCLREGLIB) del $(TCLREGLIB) clean: default-clean clean-pkgs hose: default-hose realclean: hose # Local Variables: # mode: makefile # End: | > | 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 | @if exist $(TCLDDELIB) del $(TCLDDELIB) @echo Removing $(TCLREGLIB) ... @if exist $(TCLREGLIB) del $(TCLREGLIB) clean: default-clean clean-pkgs hose: default-hose realclean: hose .PHONY: # Local Variables: # mode: makefile # End: |
Changes to win/nmakehlp.c.
︙ | ︙ | |||
15 16 17 18 19 20 21 | #define _CRT_SECURE_NO_DEPRECATE #include <windows.h> #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") #include <stdio.h> #include <math.h> | < < < < < < < < < | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | #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 */ |
︙ | ︙ |
Changes to win/rules-ext.vc.
︙ | ︙ | |||
27 28 29 30 31 32 33 | !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. | | | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | !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:/=\) |
︙ | ︙ |
Changes to win/rules.vc.
1 2 3 4 5 6 7 8 | #------------------------------------------------------------- -*- makefile -*- # rules.vc -- # # Part of the nmake based build system for Tcl and its extensions. # This file does all the hard work in terms of parsing build options, # compiler switches, defining common targets and macros. The Tcl makefile # directly includes this. Extensions include it via "rules-ext.vc". # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | #------------------------------------------------------------- -*- makefile -*- # rules.vc -- # # Part of the nmake based build system for Tcl and its extensions. # This file does all the hard work in terms of parsing build options, # compiler switches, defining common targets and macros. The Tcl makefile # directly includes this. Extensions include it via "rules-ext.vc". # # See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for # detailed documentation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 2001-2003 David Gravereaux. # Copyright (c) 2003-2008 Patrick Thoyts # Copyright (c) 2017 Ashok P. Nadkarni #------------------------------------------------------------------------------ !ifndef _RULES_VC _RULES_VC = 1 # The following macros define the version of the rules.vc nmake build system # For modifications that are not backward-compatible, you *must* change # the major version. RULES_VERSION_MAJOR = 1 RULES_VERSION_MINOR = 9 # 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)" == "" |
︙ | ︙ | |||
648 649 650 651 652 653 654 655 | # If compiler has enabled link time optimization, linker must too with -ltcg !ifdef CC_GL_OPT_ENABLED !if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS) -ltcg !endif !endif ######################################################################## | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | | 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 | # If compiler has enabled link time optimization, linker must too with -ltcg !ifdef CC_GL_OPT_ENABLED !if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS) -ltcg !endif !endif ################################################################ # 6. Extract various version numbers from headers # For Tcl and Tk, version numbers are extracted from tcl.h and tk.h # respectively. For extensions, versions are extracted from the # configure.in or configure.ac from the TEA configuration if it # exists, and unset otherwise. # Sets the following macros: # TCL_MAJOR_VERSION # TCL_MINOR_VERSION # TCL_RELEASE_SERIAL # TCL_PATCH_LEVEL # TCL_PATCH_LETTER # TCL_VERSION # TK_MAJOR_VERSION # TK_MINOR_VERSION # TK_RELEASE_SERIAL # TK_PATCH_LEVEL # TK_PATCH_LETTER # TK_VERSION # DOTVERSION - set as (for example) 2.5 # VERSION - set as (for example 25) #-------------------------------------------------------------- !if [echo REM = This file is generated from rules.vc > versions.vc] !endif !if [echo TCL_MAJOR_VERSION = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc] !endif !if [echo TCL_MINOR_VERSION = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc] !endif !if [echo TCL_RELEASE_SERIAL = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" TCL_RELEASE_SERIAL >> versions.vc] !endif !if [echo TCL_PATCH_LEVEL = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc] !endif !if defined(_TK_H) !if [echo TK_MAJOR_VERSION = \>> versions.vc] \ && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc] !endif !if [echo TK_MINOR_VERSION = \>> versions.vc] \ && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc] !endif !if [echo TK_RELEASE_SERIAL = \>> versions.vc] \ && [nmakehlp -V "$(_TK_H)" TK_RELEASE_SERIAL >> versions.vc] !endif !if [echo TK_PATCH_LEVEL = \>> versions.vc] \ && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc] !endif !endif # _TK_H !include versions.vc TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) TCL_DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) !if [nmakehlp -f $(TCL_PATCH_LEVEL) "a"] TCL_PATCH_LETTER = a !elseif [nmakehlp -f $(TCL_PATCH_LEVEL) "b"] TCL_PATCH_LETTER = b !else TCL_PATCH_LETTER = . !endif !if defined(_TK_H) TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION) TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) !if [nmakehlp -f $(TK_PATCH_LEVEL) "a"] TK_PATCH_LETTER = a !elseif [nmakehlp -f $(TK_PATCH_LEVEL) "b"] TK_PATCH_LETTER = b !else TK_PATCH_LETTER = . !endif !endif # Set DOTVERSION and VERSION !if $(DOING_TCL) DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) VERSION = $(TCL_VERSION) !elseif $(DOING_TK) DOTVERSION = $(TK_DOTVERSION) VERSION = $(TK_VERSION) !else # Doing a non-Tk extension # If parent makefile has not defined DOTVERSION, try to get it from TEA # first from a configure.in file, and then from configure.ac !ifndef DOTVERSION !if [echo DOTVERSION = \> versions.vc] \ || [nmakehlp -V $(ROOT)\configure.in ^[$(PROJECT)^] >> versions.vc] !if [echo DOTVERSION = \> versions.vc] \ || [nmakehlp -V $(ROOT)\configure.ac ^[$(PROJECT)^] >> versions.vc] !error *** Could not figure out extension version. Please define DOTVERSION in parent makefile before including rules.vc. !endif !endif !include versions.vc !endif # DOTVERSION VERSION = $(DOTVERSION:.=) !endif # $(DOING_TCL) ... etc. # Windows RC files have 3 version components. Ensure this irrespective # of how many components the package has specified. Basically, ensure # minimum 4 components by appending 4 0's and then pick out the first 4. # Also take care of the fact that DOTVERSION may have "a" or "b" instead # of "." separating the version components. DOTSEPARATED=$(DOTVERSION:a=.) DOTSEPARATED=$(DOTSEPARATED:b=.) !if [echo RCCOMMAVERSION = \> versions.vc] \ || [for /f "tokens=1,2,3,4,5* delims=." %a in ("$(DOTSEPARATED).0.0.0.0") do echo %a,%b,%c,%d >> versions.vc] !error *** Could not generate RCCOMMAVERSION *** !endif !include versions.vc ######################################################################## # 7. Parse the OPTS macro to work out the requested build configuration. # Based on this, we will construct the actual switches to be passed to the # compiler and linker using the macros defined in the previous section. # The following macros are defined by this section based on OPTS # STATIC_BUILD - 0 -> Tcl is to be built as a shared library # 1 -> build as a static library and shell # TCL_THREADS - legacy but always 1 on Windows since winsock requires it. # DEBUG - 1 -> debug build, 0 -> release builds # SYMBOLS - 1 -> generate PDB's, 0 -> no PDB's # PROFILE - 1 -> generate profiling info, 0 -> no profiling # PGO - 1 -> profile based optimization, 0 -> no # MSVCRT - 1 -> link to dynamic C runtime even when building static Tcl build # 0 -> link to static C runtime for static Tcl build. # Does not impact shared Tcl builds (STATIC_BUILD == 0) # Default: 1 for Tcl 8.7 and up, 0 otherwise. # TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions # in the Tcl and Wish shell. 0 -> keep them as shared libraries. Does # not impact shared Tcl builds. Implied by STATIC_BUILD since Tcl 8.7. # USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation. # 0 -> Use the non-thread allocator. # UNCHECKED - 1 -> when doing a debug build with symbols, use the release # C runtime, 0 -> use the debug C runtime. # USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking # CONFIG_CHECK - 1 -> check current build configuration against Tcl # configuration (ignored for Tcl itself) |
︙ | ︙ | |||
720 721 722 723 724 725 726 | !if [nmakehlp -f $(OPTS) "nomsvcrt"] !message *** Doing nomsvcrt MSVCRT = 0 !else !if [nmakehlp -f $(OPTS) "msvcrt"] !message *** Doing msvcrt !else | | | | 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 | !if [nmakehlp -f $(OPTS) "nomsvcrt"] !message *** Doing nomsvcrt MSVCRT = 0 !else !if [nmakehlp -f $(OPTS) "msvcrt"] !message *** Doing msvcrt !else !if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7 && $(STATIC_BUILD) MSVCRT = 0 !endif !endif !endif # [nmakehlp -f $(OPTS) "nomsvcrt"] !if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD) !message *** Doing staticpkg TCL_USE_STATIC_PACKAGES = 1 !endif !if [nmakehlp -f $(OPTS) "nothreads"] !message *** Compile explicitly for non-threaded tcl TCL_THREADS = 0 USE_THREAD_ALLOC= 0 !endif !if $(TCL_MAJOR_VERSION) == 8 !if [nmakehlp -f $(OPTS) "time64bit"] !message *** Force 64-bit time_t _USE_64BIT_TIME_T = 1 !endif !if [nmakehlp -f $(OPTS) "utfmax"] !message *** Force allowing 4-byte UTF-8 sequences internally |
︙ | ︙ | |||
832 833 834 835 836 837 838 | MSG=^ This compiler does not support profile guided optimization. !error $(MSG) !endif !endif ################################################################ | | | 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 | MSG=^ This compiler does not support profile guided optimization. !error $(MSG) !endif !endif ################################################################ # 8. Parse the STATS macro to configure code instrumentation # The following macros are set by this section: # TCL_MEM_DEBUG - 1 -> enables memory allocation instrumentation # 0 -> disables # TCL_COMPILE_DEBUG - 1 -> enables byte compiler logging # 0 -> disables # Default both are off |
︙ | ︙ | |||
862 863 864 865 866 867 868 | !else TCL_COMPILE_DEBUG = 0 !endif !endif #################################################################### | | | 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 | !else TCL_COMPILE_DEBUG = 0 !endif !endif #################################################################### # 9. Parse the CHECKS macro to configure additional compiler checks # The following macros are set by this section: # WARNINGS - compiler switches that control the warnings level # TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions # 0 -> enable deprecated functions # Defaults - Permit deprecated functions and warning level 3 TCL_NO_DEPRECATED = 0 |
︙ | ︙ | |||
894 895 896 897 898 899 900 | !if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64] !message *** Doing 64bit portability warnings WARNINGS = $(WARNINGS) -Wp64 !endif !endif | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 | !if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64] !message *** Doing 64bit portability warnings WARNINGS = $(WARNINGS) -Wp64 !endif !endif ################################################################ # 10. Construct output directory and file paths # Figure-out how to name our intermediate and output directories. # In order to avoid inadvertent mixing of object files built using # different compilers, build configurations etc., # |
︙ | ︙ | |||
1083 1084 1085 1086 1087 1088 1089 1090 | !error *** Could not fully qualify path TMP_DIR=$(TMP_DIR) !endif !include nmakehlp.out # The name of the stubs library for the project being built STUBPREFIX = $(PROJECT)stub # Set up paths to various Tcl executables and libraries needed by extensions | > > | > > > > > | 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 | !error *** Could not fully qualify path TMP_DIR=$(TMP_DIR) !endif !include nmakehlp.out # The name of the stubs library for the project being built STUBPREFIX = $(PROJECT)stub # # 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) TCLSCRIPTZIP = $(OUT_DIR)\$(TCLSCRIPTZIPNAME) TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" !else # !$(DOING_TCL) |
︙ | ︙ | |||
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 | # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif TCL_LIBRARY = $(_TCLDIR)\lib TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib TCLDDELIB = $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target TCL_INCLUDES = -I"$(_TCLDIR)\include" !else # Building against Tcl sources TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe !if !exist($(TCLSH)) TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe !endif TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib # When building extensions, may be linking against Tcl that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif TCL_LIBRARY = $(_TCLDIR)\library TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib TCLTOOLSDIR = $(_TCLDIR)\tools TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" !endif # TCLINSTALL tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)" | > > | 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 | # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif TCL_LIBRARY = $(_TCLDIR)\lib TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib TCLDDELIB = $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib TCLSCRIPTZIP = $(_TCLDIR)\lib\$(TCLSCRIPTZIPNAME) TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target TCL_INCLUDES = -I"$(_TCLDIR)\include" !else # Building against Tcl sources TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe !if !exist($(TCLSH)) TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe !endif TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib # When building extensions, may be linking against Tcl that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif TCL_LIBRARY = $(_TCLDIR)\library TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib TCLSCRIPTZIP = $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCLSCRIPTZIPNAME) TCLTOOLSDIR = $(_TCLDIR)\tools TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" !endif # TCLINSTALL tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)" |
︙ | ︙ | |||
1160 1161 1162 1163 1164 1165 1166 | !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 | | > > | > > > > > | > > > > > > > | > > > > > > | 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 | !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)" TKSCRIPTZIP = $(OUT_DIR)\$(TKSCRIPTZIPNAME) !else # effectively NEED_TK !if $(TKINSTALL) # Building against installed Tk WISH = $(_TKDIR)\bin\$(WISHNAME) TKSTUBLIB = $(_TKDIR)\lib\$(TKSTUBLIBNAME) TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) # When building extensions, may be linking against Tk that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TKIMPLIB)") TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) !endif TK_INCLUDES = -I"$(_TKDIR)\include" TKSCRIPTZIP = $(_TKDIR)\lib\$(TKSCRIPTZIPNAME) !else # Building against Tk sources WISH = $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME) TKSTUBLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME) TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) # When building extensions, may be linking against Tk that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TKIMPLIB)") TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) !endif TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib" TKSCRIPTZIP = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSCRIPTZIPNAME) !endif # TKINSTALL 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. |
︙ | ︙ | |||
1282 1283 1284 1285 1286 1287 1288 | # 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 | | | 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 | # 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 !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 !endif |
︙ | ︙ | |||
1319 1320 1321 1322 1323 1324 1325 | OPTDEFINES = $(OPTDEFINES) /DTCL_NO_DEPRECATED !endif !if $(USE_STUBS) # Note we do not define USE_TCL_STUBS even when building tk since some # test targets in tk do not use stubs !if !$(DOING_TCL) | | | 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 | OPTDEFINES = $(OPTDEFINES) /DTCL_NO_DEPRECATED !endif !if $(USE_STUBS) # Note we do not define USE_TCL_STUBS even when building tk since some # test targets in tk do not use stubs !if !$(DOING_TCL) USE_STUBS_DEFS = /DUSE_TCL_STUBS=1 /DUSE_TCLOO_STUBS=1 !if $(NEED_TK) USE_STUBS_DEFS = $(USE_STUBS_DEFS) /DUSE_TK_STUBS !endif !endif !endif # USE_STUBS !if !$(DEBUG) |
︙ | ︙ | |||
1452 1453 1454 1455 1456 1457 1458 | # here irrespective of the OPTS setting. # # TBD - tclvfs has a comment that stubs libs should not be compiled with -GL # without stating why. Tcl itself compiled stubs libs with this flag. # so we do not remove it from cflags. -GL may prevent extensions # compiled with one VC version to fail to link against stubs library # compiled with another VC version. Check for this and fix accordingly. | | | 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 | # here irrespective of the OPTS setting. # # TBD - tclvfs has a comment that stubs libs should not be compiled with -GL # without stating why. Tcl itself compiled stubs libs with this flag. # so we do not remove it from cflags. -GL may prevent extensions # compiled with one VC version to fail to link against stubs library # compiled with another VC version. Check for this and fix accordingly. stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) /Zl /GL- /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS) # Link flags !if $(DEBUG) ldebug = -debug -debugtype:cv !else ldebug = -release -opt:ref -opt:icf,3 |
︙ | ︙ | |||
1475 1476 1477 1478 1479 1480 1481 | !endif ### Declarations common to all linker versions lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) !if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900 lflags = $(lflags) -nodefaultlib:libucrt.lib | < < < < < < < < < < < < | 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 | !endif ### Declarations common to all linker versions lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) !if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900 lflags = $(lflags) -nodefaultlib:libucrt.lib !endif dlllflags = $(lflags) -dll conlflags = $(lflags) -subsystem:console guilflags = $(lflags) -subsystem:windows # Libraries that are required for every image. |
︙ | ︙ | |||
1545 1546 1547 1548 1549 1550 1551 1552 | DEFAULT_BUILD_TARGET = $(PROJECT) !endif default-target: $(DEFAULT_BUILD_TARGET) !if $(MULTIPLATFORM_INSTALL) default-pkgindex: @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ | > | > > > > > | > > > > > > | 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 | 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 |
︙ | ︙ | |||
1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 | @if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)" @$(CPY) $(PRJSTUBLIB) "$(SCRIPT_INSTALL_DIR)" >NUL default-install-pdbs: @echo Installing PDBs to '$(LIB_INSTALL_DIR)' @if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)" @$(CPY) "$(OUT_DIR)\*.pdb" "$(LIB_INSTALL_DIR)\" default-install-docs-html: @echo Installing documentation files to '$(DOC_INSTALL_DIR)' @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)" @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.html" "$(DOCDIR)\*.css" "$(DOCDIR)\*.png") do @$(COPY) %f "$(DOC_INSTALL_DIR)" default-install-docs-n: | > > | 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 | @if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)" @$(CPY) $(PRJSTUBLIB) "$(SCRIPT_INSTALL_DIR)" >NUL default-install-pdbs: @echo Installing PDBs to '$(LIB_INSTALL_DIR)' @if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)" @$(CPY) "$(OUT_DIR)\*.pdb" "$(LIB_INSTALL_DIR)\" # "emacs font-lock highlighting fix default-install-docs-html: @echo Installing documentation files to '$(DOC_INSTALL_DIR)' @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)" @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.html" "$(DOCDIR)\*.css" "$(DOCDIR)\*.png") do @$(COPY) %f "$(DOC_INSTALL_DIR)" default-install-docs-n: |
︙ | ︙ | |||
1760 1761 1762 1763 1764 1765 1766 | !if !$(DOING_TCL) !if $(TCLINSTALL) # Building against an installed Tcl !if exist("$(_TCLDIR)\lib\nmake\tcl.nmake") TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake" !endif !else # !$(TCLINSTALL) - building against Tcl source | | | | 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 | !if !$(DOING_TCL) !if $(TCLINSTALL) # Building against an installed Tcl !if exist("$(_TCLDIR)\lib\nmake\tcl.nmake") TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake" !endif !else # !$(TCLINSTALL) - building against Tcl source !if exist("$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake") TCLNMAKECONFIG = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake" !endif !endif # TCLINSTALL !if $(CONFIG_CHECK) !ifdef TCLNMAKECONFIG !include $(TCLNMAKECONFIG) |
︙ | ︙ |
Changes to win/targets.vc.
1 2 3 4 5 6 | #------------------------------------------------------------- -*- makefile -*- # targets.vc -- # # Part of the nmake based build system for Tcl and its extensions. # This file defines some standard targets for the convenience of extensions # and can be optionally included by the extension makefile. | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | #------------------------------------------------------------- -*- makefile -*- # targets.vc -- # # Part of the nmake based build system for Tcl and its extensions. # This file defines some standard targets for the convenience of extensions # and can be optionally included by the extension makefile. # See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for docs. $(PROJECT): setup pkgindex $(PRJLIB) !ifdef PRJ_STUBOBJS $(PROJECT): $(PRJSTUBLIB) $(PRJSTUBLIB): $(PRJ_STUBOBJS) $(LIBCMD) $** |
︙ | ︙ |
Changes to win/tcl.dsp.
︙ | ︙ | |||
30 31 32 33 34 35 36 | !IF "$(CFG)" == "tcl - Win32 Release" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "Release" # PROP BASE Intermediate_Dir "Release\tcl_Dynamic" | | | | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | !IF "$(CFG)" == "tcl - Win32 Release" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "Release" # PROP BASE Intermediate_Dir "Release\tcl_Dynamic" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" # PROP BASE Target_File "Release\tclsh90.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "Release" # PROP Intermediate_Dir "Release\tcl_Dynamic" # PROP Cmd_Line "nmake -nologo -f makefile.vc MSVCDIR=IDE" # PROP Rebuild_Opt "clean release" # PROP Target_File "Release\tclsh90t.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ELSEIF "$(CFG)" == "tcl - Win32 Debug" |
︙ | ︙ | |||
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 |
︙ | ︙ | |||
1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 | SOURCE=..\generic\tclStubInit.c # End Source File # Begin Source File SOURCE=..\generic\tclStubLib.c # End Source File # Begin Source File SOURCE=..\generic\tclOOStubLib.c # End Source File # Begin Source File SOURCE=..\generic\tclTomMathStubLib.c # End Source File | > > > > > > > > > > > > > > > > | 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 | SOURCE=..\generic\tclStubInit.c # End Source File # Begin Source File SOURCE=..\generic\tclStubLib.c # End Source File # Begin Source File SOURCE=..\generic\tclStubFindExecutable.c # End Source File # Begin Source File SOURCE=..\generic\tclStubInitSubsystems.c # End Source File # Begin Source File SOURCE=..\generic\tclStubSetPanicProc.c # End Source File # Begin Source File SOURCE=..\generic\tclStubLibTbl.c # End Source File # Begin Source File SOURCE=..\generic\tclOOStubLib.c # End Source File # Begin Source File SOURCE=..\generic\tclTomMathStubLib.c # End Source File |
︙ | ︙ | |||
1438 1439 1440 1441 1442 1443 1444 | SOURCE=.\rmd.bat # End Source File # Begin Source File SOURCE=.\rules.vc # End Source File | < < < < | 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 | SOURCE=.\rmd.bat # End Source File # Begin Source File SOURCE=.\rules.vc # End Source File # Begin Source File SOURCE=.\tcl.m4 # End Source File # Begin Source File SOURCE=.\tcl.rc |
︙ | ︙ |
Deleted win/tcl.hpj.in.
|
| < < < < < < < < < < < < < < < < < < < |
Changes to win/tcl.m4.
︙ | ︙ | |||
24 25 26 27 28 29 30 | # the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then # we reset no_tcl in case something fails here no_tcl=true AC_ARG_WITH(tcl, | | | | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | # the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then # we reset no_tcl in case something fails here no_tcl=true AC_ARG_WITH(tcl, AS_HELP_STRING([--with-tcl], [directory containing tcl configuration (tclConfig.sh)]), [with_tclconfig="${withval}"]) AC_MSG_CHECKING([for Tcl configuration]) AC_CACHE_VAL(ac_cv_c_tclconfig,[ # First check to see if --with-tcl was specified. if test x"${with_tclconfig}" != x ; then case "${with_tclconfig}" in */tclConfig.sh ) |
︙ | ︙ | |||
142 143 144 145 146 147 148 | # the alternative search directory is invoked by --with-tk # if test x"${no_tk}" = x ; then # we reset no_tk in case something fails here no_tk=true AC_ARG_WITH(tk, | | | | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 | # the alternative search directory is invoked by --with-tk # if test x"${no_tk}" = x ; then # we reset no_tk in case something fails here no_tk=true AC_ARG_WITH(tk, AS_HELP_STRING([--with-tk], [directory containing tk configuration (tkConfig.sh)]), [with_tkconfig="${withval}"]) AC_MSG_CHECKING([for Tk configuration]) AC_CACHE_VAL(ac_cv_c_tkconfig,[ # First check to see if --with-tkconfig was specified. if test x"${with_tkconfig}" != x ; then case "${with_tkconfig}" in */tkConfig.sh ) |
︙ | ︙ | |||
247 248 249 250 251 252 253 | # # Results: # # Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE | < | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 | # # Results: # # Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE # #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then |
︙ | ︙ | |||
284 285 286 287 288 289 290 | eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" AC_SUBST(TCL_VERSION) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) | < | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 | eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" AC_SUBST(TCL_VERSION) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC) |
︙ | ︙ | |||
354 355 356 357 358 359 360 | #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, [ --enable-shared build and link with shared libraries (default: on)], [tcl_ok=$enableval], [tcl_ok=yes]) | < < < < < < < < | 352 353 354 355 356 357 358 359 360 361 362 363 364 365 | #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, [ --enable-shared build and link with shared libraries (default: on)], [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes" ; then AC_MSG_RESULT([shared]) SHARED_BUILD=1 else AC_MSG_RESULT([static]) SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) |
︙ | ︙ | |||
459 460 461 462 463 464 465 466 467 468 469 470 471 472 | # Results: # # Can the following vars: # EXTRA_CFLAGS # CFLAGS_DEBUG # CFLAGS_OPTIMIZE # CFLAGS_WARNING # LDFLAGS_DEBUG # LDFLAGS_OPTIMIZE # LDFLAGS_CONSOLE # LDFLAGS_WINDOW # CC_OBJNAME # CC_EXENAME # CYGPATH | > | 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 | # Results: # # Can the following vars: # EXTRA_CFLAGS # CFLAGS_DEBUG # CFLAGS_OPTIMIZE # CFLAGS_WARNING # CFLAGS_NOLTO # LDFLAGS_DEBUG # LDFLAGS_OPTIMIZE # LDFLAGS_CONSOLE # LDFLAGS_WINDOW # CC_OBJNAME # CC_EXENAME # CYGPATH |
︙ | ︙ | |||
513 514 515 516 517 518 519 | # which requires x86|amd64|ia64. MACHINE="X86" if test "$GCC" = "yes"; then AC_CACHE_CHECK(for cross-compile version of gcc, ac_cv_cross, | | | | | | 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 | # which requires x86|amd64|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([[ #ifndef _WIN32 #error cross-compiler #endif ]], [[]])], [ac_cv_cross=no], [ac_cv_cross=yes]) ) if test "$ac_cv_cross" = "yes"; then case "$do64bit" in amd64|x64|yes) CC="x86_64-w64-mingw32-${CC}" LD="x86_64-w64-mingw32-ld" |
︙ | ︙ | |||
580 581 582 583 584 585 586 | # set various compiler flags depending on whether we are using gcc or cl if test "${GCC}" = "yes" ; then extra_cflags="-pipe" extra_ldflags="-pipe -static-libgcc" AC_CACHE_CHECK(for mingw32 version of gcc, ac_cv_win32, | | | | | | | < | | > > > > > > > > > > > > > > > > > > > > | 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 | # set various compiler flags depending on whether we are using gcc or cl if test "${GCC}" = "yes" ; then extra_cflags="-pipe" extra_ldflags="-pipe -static-libgcc" AC_CACHE_CHECK(for mingw32 version of gcc, ac_cv_win32, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef _WIN32 #error win32 #endif ]], [[]])], [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 if test "$ac_cv_nolto" = "yes" ; then CFLAGS_NOLTO="-fno-lto" else CFLAGS_NOLTO="" fi AC_CACHE_CHECK([if the compiler understands -finput-charset], tcl_cv_cc_input_charset, [ 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" |
︙ | ︙ | |||
678 679 680 681 682 683 684 | LDFLAGS_OPTIMIZE= case "${CC}" in *++) CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" ;; *) | | | 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 | LDFLAGS_OPTIMIZE= case "${CC}" in *++) CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" ;; *) CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -fextended-identifiers" ;; esac # Specify the CC output file names based on the target name CC_OBJNAME="-o \[$]@" CC_EXENAME="-o \[$]@" |
︙ | ︙ | |||
713 714 715 716 717 718 719 | AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) ;; ia64) MACHINE="IA64" AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) ;; *) | | | | | | | | | 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 | AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) ;; ia64) MACHINE="IA64" AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) ;; *) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifndef _WIN64 #error 32-bit #endif ]], [[]])], [tcl_win_64bit=yes], [tcl_win_64bit=no] ) if test "$tcl_win_64bit" = "yes" ; then do64bit=amd64 MACHINE="AMD64" AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi ;; esac else if test "${SHARED_BUILD}" = "0" ; then # static AC_MSG_RESULT([using static flags]) |
︙ | ︙ | |||
847 848 849 850 851 852 853 | if test "$do64bit" != "no" ; then AC_DEFINE(TCL_CFG_DO64BIT) fi if test "${GCC}" = "yes" ; then AC_CACHE_CHECK(for SEH support in compiler, tcl_cv_seh, | | | | | | | | | | | | | | | | | < | | | > | 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 | if test "$do64bit" != "no" ; then AC_DEFINE(TCL_CFG_DO64BIT) fi if test "${GCC}" = "yes" ; then AC_CACHE_CHECK(for SEH support in compiler, tcl_cv_seh, AC_RUN_IFELSE([AC_LANG_SOURCE([[ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN int main(int argc, char** argv) { int a, b = 0; __try { a = 666 / b; } __except (EXCEPTION_EXECUTE_HANDLER) { return 0; } return 1; } ]])], [tcl_cv_seh=yes], [tcl_cv_seh=no], [tcl_cv_seh=no]) ) if test "$tcl_cv_seh" = "no" ; then AC_DEFINE(HAVE_NO_SEH, 1, [Defined when mingw does not support SEH]) fi # # Check to see if the excpt.h include file provided contains the # definition for EXCEPTION_DISPOSITION; if not, which is the case # with Cygwin's version as of 2002-04-10, define it to be int, # sufficient for getting the current code to work. # AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files, tcl_cv_eh_disposition, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ # define WIN32_LEAN_AND_MEAN # include <windows.h> # undef WIN32_LEAN_AND_MEAN ]], [[ EXCEPTION_DISPOSITION x; ]])], [tcl_cv_eh_disposition=yes], [tcl_cv_eh_disposition=no]) ) if test "$tcl_cv_eh_disposition" = "no" ; then AC_DEFINE(EXCEPTION_DISPOSITION, int, [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION]) fi # Check to see if winnt.h defines CHAR, SHORT, and LONG # even if VOID has already been #defined. The win32api # used by mingw and cygwin is known to do this. AC_CACHE_CHECK(for winnt.h that ignores VOID define, tcl_cv_winnt_ignore_void, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #define VOID void #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN ]], [[ CHAR c; SHORT s; LONG l; ]])], [tcl_cv_winnt_ignore_void=yes], [tcl_cv_winnt_ignore_void=no]) ) if test "$tcl_cv_winnt_ignore_void" = "yes" ; then AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1, [Defined when cygwin/mingw ignores VOID define in winnt.h]) fi AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],) # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. AC_CACHE_CHECK(for cast to union support, tcl_cv_cast_to_union, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[ union foo { int i; double d; }; union foo f = (union foo) (int) 0; ]])], [tcl_cv_cast_to_union=yes], [tcl_cv_cast_to_union=no]) ) if test "$tcl_cv_cast_to_union" = "yes"; then AC_DEFINE(HAVE_CAST_TO_UNION, 1, [Defined when compiler supports casting to union type.]) fi fi # DL_LIBS is empty, but then we match the Unix version AC_SUBST(DL_LIBS) AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) AC_SUBST(CFLAGS_NOLTO) ]) #------------------------------------------------------------------------ # SC_WITH_TCL -- # # Location of the Tcl build directory. # |
︙ | ︙ | |||
1103 1104 1105 1106 1107 1108 1109 | # VC_MANIFEST_EMBED_EXE # #-------------------------------------------------------------------- AC_DEFUN([SC_EMBED_MANIFEST], [ AC_MSG_CHECKING(whether to embed manifest) AC_ARG_ENABLE(embedded-manifest, | | | 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 | # VC_MANIFEST_EMBED_EXE # #-------------------------------------------------------------------- AC_DEFUN([SC_EMBED_MANIFEST], [ AC_MSG_CHECKING(whether to embed manifest) AC_ARG_ENABLE(embedded-manifest, AS_HELP_STRING([--enable-embedded-manifest], [embed manifest if possible (default: yes)]), [embed_ok=$enableval], [embed_ok=yes]) VC_MANIFEST_EMBED_DLL= VC_MANIFEST_EMBED_EXE= result=no if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \ |
︙ | ︙ |
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); |
︙ | ︙ | |||
160 161 162 163 164 165 166 | Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } | | | | | | 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 | Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { if ((Tcl_Init)(interp) == TCL_ERROR) { 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) { |
︙ | ︙ | |||
203 204 205 206 207 208 209 | /* * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no * user-specific startup file will be run under any conditions. */ | | | 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 | /* * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no * user-specific startup file will be run under any conditions. */ Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); return TCL_OK; } /* *------------------------------------------------------------------------- * |
︙ | ︙ |
Changes to win/tclWin32Dll.c.
1 2 3 4 5 6 | /* * tclWin32Dll.c -- * * This file contains the DLL entry point and other low-level bit bashing * code that needs inline assembly. * | | | < < < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | /* * tclWin32Dll.c -- * * This file contains the DLL entry point and other low-level bit bashing * code that needs inline assembly. * * Copyright © 1995-1996 Sun Microsystems, Inc. * Copyright © 1998-2000 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" #if defined(HAVE_INTRIN_H) # include <intrin.h> #endif /* * The following variables keep track of information about this DLL on a * per-instance basis. Each time this DLL is loaded, it gets its own new data * segment with its own copy of all static and global information. */ static HINSTANCE hInstance; /* HINSTANCE of this DLL. */ /* * The following declaration is for the VC++ DLL entry point. */ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, LPVOID reserved); |
︙ | ︙ | |||
181 182 183 184 185 186 187 | OSVERSIONINFOW os; hInstance = hInst; os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); GetVersionExW(&os); /* | | | | | 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | OSVERSIONINFOW os; hInstance = hInst; os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); GetVersionExW(&os); /* * We no longer support Win32s or Win9x or Windows CE or Windows XP, so just * in case someone manages to get a runtime there, make sure they know that. */ if (os.dwPlatformId != VER_PLATFORM_WIN32_NT) { Tcl_Panic("Windows 7 is the minimum supported platform"); } } /* *------------------------------------------------------------------------- * * TclWinNoBackslash -- |
︙ | ︙ |
Changes to win/tclWinChan.c.
1 2 3 4 5 6 | /* * tclWinChan.c * * Channel drivers for Windows channels based on files, command pipes and * TCP sockets. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclWinChan.c * * Channel drivers for Windows channels based on files, command pipes and * TCP sockets. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" #include "tclIO.h" |
︙ | ︙ | |||
81 82 83 84 85 86 87 | static int FileGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static ThreadSpecificData *FileInit(void); static int FileInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); | | | | | 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | static int FileGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static ThreadSpecificData *FileInit(void); static int FileInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static long long FileWideSeekProc(ClientData instanceData, long long offset, int mode, int *errorCode); static void FileSetupProc(ClientData clientData, int flags); static void FileWatchProc(ClientData instanceData, int mask); static void FileThreadActionProc(ClientData instanceData, int action); static int FileTruncateProc(ClientData instanceData, long long length); static DWORD FileGetType(HANDLE handle); static int NativeIsComPort(const WCHAR *nativeName); /* * This structure describes the channel type structure for file based IO. */ |
︙ | ︙ | |||
409 410 411 412 413 414 415 | */ 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) { | | | 409 410 411 412 413 414 415 416 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) { Tcl_WinConvertError(GetLastError()); errorCode = errno; } } /* * See if this FileInfo* is still on the thread local list. */ |
︙ | ︙ | |||
455 456 457 458 459 460 461 | * Side effects: * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ | | | | 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 | * Side effects: * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ static long long FileWideSeekProc( ClientData instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { FileInfo *infoPtr = (FileInfo *)instanceData; DWORD moveMethod; LONG newPos, newPosHigh; |
︙ | ︙ | |||
482 483 484 485 486 487 488 | 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) { | | | | | 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 | 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)); } /* *---------------------------------------------------------------------- * * FileTruncateProc -- * |
︙ | ︙ | |||
510 511 512 513 514 515 516 | * *---------------------------------------------------------------------- */ static int FileTruncateProc( ClientData instanceData, /* File state. */ | | | | | | 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 | * *---------------------------------------------------------------------- */ static int FileTruncateProc( ClientData instanceData, /* File state. */ long long length) /* Length to truncate at. */ { FileInfo *infoPtr = (FileInfo *)instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; /* * Save where we were... */ 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. */ |
︙ | ︙ | |||
612 613 614 615 616 617 618 | */ if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead, (LPOVERLAPPED) NULL) != FALSE) { return bytesRead; } | | | 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | */ 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; } |
︙ | ︙ | |||
661 662 663 664 665 666 667 | 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) { | | | 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 | 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; } |
︙ | ︙ | |||
836 837 838 839 840 841 842 | * 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) { | | | 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 | * 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; } |
︙ | ︙ | |||
893 894 895 896 897 898 899 | 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; } | | | 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 | 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; } |
︙ | ︙ | |||
917 918 919 920 921 922 923 | * * Reopen channel for OVERLAPPED operation. Normally this shouldn't * fail, because the channel exists. */ handle = TclWinSerialOpen(handle, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { | | | 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 | * * 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.
1 2 3 4 5 6 | /* * tclWinConsole.c -- * * This file implements the Windows-specific console functions, and the * "console" channel driver. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclWinConsole.c -- * * This file implements the Windows-specific console functions, and the * "console" channel driver. * * Copyright © 1999 Scriptics Corp. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" |
︙ | ︙ | |||
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/tclWinDde.c.
︙ | ︙ | |||
75 76 77 78 79 80 81 | */ static HSZ ddeServiceGlobal = 0; static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; | | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | */ static HSZ ddeServiceGlobal = 0; static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; #define TCL_DDE_VERSION "1.4.4" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME L"TclEval" #define TCL_DDE_EXECUTE_RESULT L"$TCLEVAL$EXECUTE$RESULT" #define DDE_FLAG_ASYNC 1 #define DDE_FLAG_BINARY 2 #define DDE_FLAG_FORCE 4 |
︙ | ︙ |
Changes to win/tclWinError.c.
1 2 3 4 5 6 | /* * tclWinError.c -- * * This file contains code for converting from Win32 errors to errno * errors. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclWinError.c -- * * This file contains code for converting from Win32 errors to errno * errors. * * Copyright © 1995-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* |
︙ | ︙ | |||
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 ((unsigned)errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { errCode -= WSAEWOULDBLOCK; if ((unsigned)errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) { Tcl_SetErrno(errorTable[1]); } else { Tcl_SetErrno(wsaErrorTable[errCode]); |
︙ | ︙ | |||
403 404 405 406 407 408 409 | if (msgString[TCL_MAX_WARN_LEN-1] != '\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } OutputDebugStringW(msgString); } else { if (!isatty(fileno(stderr))) { | | | 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 | if (msgString[TCL_MAX_WARN_LEN-1] != '\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } OutputDebugStringW(msgString); } else { if (!isatty(fileno(stderr))) { fprintf(stderr, "\xEF\xBB\xBF"); } vfprintf(stderr, format, argList); fprintf(stderr, "\n"); fflush(stderr); } } #endif |
︙ | ︙ |
Changes to win/tclWinFCmd.c.
1 2 3 4 5 6 | /* * tclWinFCmd.c * * This file implements the Windows specific portion of file manipulation * subcommands of the "file" command. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclWinFCmd.c * * This file implements the Windows specific portion of file manipulation * subcommands of the "file" command. * * Copyright © 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" |
︙ | ︙ | |||
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))); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1532 1533 1534 1535 1536 1537 1538 | * root volumes (drives) formatted as NTFS are declared hidden when * they are not (and cannot be). * * We test for, and fix that case, here. */ size_t len; | | | 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 | * root volumes (drives) formatted as NTFS are declared hidden when * they are not (and cannot be). * * We test for, and fix that case, here. */ size_t len; const char *str = Tcl_GetStringFromObj(fileName, &len); if (len < 4) { if (len == 0) { /* * Not sure if this is possible, but we pass it on anyway. */ } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) { |
︙ | ︙ | |||
1621 1622 1623 1624 1625 1626 1627 | for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; Tcl_ListObjIndex(NULL, splitPath, i, &elt); | | | 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 | for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; Tcl_ListObjIndex(NULL, splitPath, i, &elt); pathv = Tcl_GetStringFromObj(elt, &length); if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':')) || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) { /* * Handle "/", "//machine/export", "c:/", "." or ".." by just * copying the string literally. Uppercase the drive letter, just * because it looks better under Windows to do so. */ |
︙ | ︙ | |||
1657 1658 1659 1660 1661 1662 1663 | Tcl_IncrRefCount(tempPath); /* * We'd like to call Tcl_FSGetNativePath(tempPath) but that is * likely to lead to infinite loops. */ | | | 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 | Tcl_IncrRefCount(tempPath); /* * We'd like to call Tcl_FSGetNativePath(tempPath) but that is * likely to lead to infinite loops. */ tempString = Tcl_GetStringFromObj(tempPath, &length); Tcl_DStringInit(&ds); nativeName = Tcl_UtfToWCharDString(tempString, length, &ds); Tcl_DecrRefCount(tempPath); handle = FindFirstFileW(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* * FindFirstFileW() doesn't like root directories. We would |
︙ | ︙ | |||
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.
1 2 3 4 5 6 7 8 | /* * tclWinFile.c -- * * This file contains temporary wrappers around UNIX file handling * functions. These wrappers map the UNIX functions to Win32 HANDLE-style * files, which can be manipulated through the Win32 console redirection * interfaces. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | /* * tclWinFile.c -- * * This file contains temporary wrappers around UNIX file handling * functions. These wrappers map the UNIX functions to Win32 HANDLE-style * files, which can be manipulated through the Win32 console redirection * interfaces. * * Copyright © 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" #include "tclFileSystem.h" |
︙ | ︙ | |||
25 26 27 28 29 30 31 | #endif /* * The number of 100-ns intervals between the Windows system epoch (1601-01-01 * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01). */ #define POSIX_EPOCH_AS_FILETIME \ | | | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | #endif /* * The number of 100-ns intervals between the Windows system epoch (1601-01-01 * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01). */ #define POSIX_EPOCH_AS_FILETIME \ ((long long) 116444736 * (long long) 1000000000) /* * Declarations for 'link' related information. This information should come * with VC++ 6.0, but is not in some older SDKs. In any case it is not well * documented. */ |
︙ | ︙ | |||
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 283 | 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 * reasonable. |
︙ | ︙ | |||
318 319 320 321 322 323 324 | 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. */ |
︙ | ︙ | |||
493 494 495 496 497 498 499 | 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; |
︙ | ︙ | |||
686 687 688 689 690 691 692 | 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); |
︙ | ︙ | |||
742 743 744 745 746 747 748 | */ 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); /* |
︙ | ︙ | |||
857 858 859 860 861 862 863 | const char *argv0) /* If NULL, install PanicMessageBox, otherwise * ignore. */ { WCHAR wName[MAX_PATH]; char name[MAX_PATH * 3]; (void)argv0; | | | 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 | const char *argv0) /* If NULL, install PanicMessageBox, otherwise * ignore. */ { WCHAR wName[MAX_PATH]; char name[MAX_PATH * 3]; (void)argv0; GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR)); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); TclWinNoBackslash(name); TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
913 914 915 916 917 918 919 | /* * Match a single file directly. */ DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; size_t length = 0; | | | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 | /* * Match a single file directly. */ DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; size_t length = 0; const char *str = Tcl_GetStringFromObj(norm, &length); native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (GetFileAttributesExW(native, GetFileExInfoStandard, &data) != TRUE) { return TCL_OK; } |
︙ | ︙ | |||
973 974 975 976 977 978 979 | /* * Build up the directory name for searching, including a trailing * directory separator. */ Tcl_DStringInit(&dsOrig); | | | 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 | /* * Build up the directory name for searching, including a trailing * directory separator. */ Tcl_DStringInit(&dsOrig); dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } |
︙ | ︙ | |||
1029 1030 1031 1032 1033 1034 1035 | * means we just return TCL_OK, indicating no results found. */ Tcl_DStringFree(&dsOrig); return TCL_OK; } | | | 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 | * 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; |
︙ | ︙ | |||
1231 1232 1233 1234 1235 1236 1237 | && path[3] >= '1' && path[3] <= '9') { /* * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { return 4; | | | | 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 | && path[3] >= '1' && path[3] <= '9') { /* * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { return 4; } else if (path[4] == ':' && path[5] == '\0') { return 4; } } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* * Have match for 'con' */ return 3; } } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { if (path[3] >= '1' && path[3] <= '9') { /* * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { return 4; } else if (path[4] == ':' && path[5] == '\0') { return 4; } } } else if (!strcasecmp(path, "prn") || !strcasecmp(path, "nul") || !strcasecmp(path, "aux")) { /* |
︙ | ︙ | |||
1578 1579 1580 1581 1582 1583 1584 | if (attr == INVALID_FILE_ATTRIBUTES) { /* * File might not exist. */ DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { | | | 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 | 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. |
︙ | ︙ | |||
1704 1705 1706 1707 1708 1709 1710 | error = GetLastError(); if (error != ERROR_INSUFFICIENT_BUFFER) { /* * Most likely case is ERROR_ACCESS_DENIED, which we will convert * to EACCES - just what we want! */ | | | 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 | 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. */ |
︙ | ︙ | |||
1809 1810 1811 1812 1813 1814 1815 | &genMap, &privSet, &privSetSize, &grantedAccess, &accessYesNo)) { /* * Unable to perform access check. */ accessError: | | | 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 | &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; |
︙ | ︙ | |||
1866 1867 1868 1869 1870 1871 1872 | return 0; } path += len-3; if ((_wcsicmp(path, L"exe") == 0) || (_wcsicmp(path, L"com") == 0) || (_wcsicmp(path, L"cmd") == 0) | < | 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 | 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; } /* |
︙ | ︙ | |||
1904 1905 1906 1907 1908 1909 1910 | if (!nativePath) { return -1; } result = SetCurrentDirectoryW(nativePath); if (result == 0) { | | | 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 | if (!nativePath) { return -1; } result = SetCurrentDirectoryW(nativePath); if (result == 0) { Tcl_WinConvertError(GetLastError()); return -1; } return 0; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1943 1944 1945 1946 1947 1948 1949 | * name of current directory. */ { WCHAR buffer[MAX_PATH]; char *p; WCHAR *native; if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { | | | 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 | * 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; } |
︙ | ︙ | |||
2074 2075 2076 2077 2078 2079 2080 | } else { CloseHandle(fileHandle); statPtr->st_atime = ToCTime(data.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.ftCreationTime); } attr = data.dwFileAttributes; | | | | 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 | } else { CloseHandle(fileHandle); statPtr->st_atime = ToCTime(data.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.ftCreationTime); } attr = data.dwFileAttributes; statPtr->st_size = ((long long) data.nFileSizeLow) | (((long long) data.nFileSizeHigh) << 32); /* * On Unix, for directories, nlink apparently depends on the number of * files in the directory. We could calculate that, but it would be a * bit of a performance penalty, I think. Hence we just use what * Windows gives us, which is the same as Unix for files, at least. */ |
︙ | ︙ | |||
2108 2109 2110 2111 2112 2113 2114 | if (GetFileAttributesExW(nativePath, GetFileExInfoStandard, &data) != TRUE) { HANDLE hFind; WIN32_FIND_DATAW ffd; DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { | | | | | | 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 | 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; statPtr->st_size = ((long long) data.nFileSizeLow) | (((long long) data.nFileSizeHigh) << 32); statPtr->st_atime = ToCTime(data.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.ftCreationTime); } dev = NativeDev(nativePath); mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath)); |
︙ | ︙ | |||
2285 2286 2287 2288 2289 2290 2291 | { LARGE_INTEGER convertedTime; convertedTime.LowPart = fileTime.dwLowDateTime; convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; return (__time64_t) ((convertedTime.QuadPart - | | | 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 | { LARGE_INTEGER convertedTime; convertedTime.LowPart = fileTime.dwLowDateTime; convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; return (__time64_t) ((convertedTime.QuadPart - (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000); } /* *------------------------------------------------------------------------ * * FromCTime -- * |
︙ | ︙ | |||
2342 2343 2344 2345 2346 2347 2348 | ClientData TclpGetNativeCwd( ClientData clientData) { WCHAR buffer[MAX_PATH]; if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { | | | 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 | 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; } |
︙ | ︙ | |||
2799 2800 2801 2802 2803 2804 2805 | Tcl_Obj *tmpPathPtr; size_t length; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); | | | 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 | Tcl_Obj *tmpPathPtr; size_t length; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); path = Tcl_GetStringFromObj(tmpPathPtr, &length); Tcl_SetStringObj(pathPtr, path, length); Tcl_DecrRefCount(tmpPathPtr); } else { /* * End of string was reached above. */ |
︙ | ︙ | |||
2884 2885 2886 2887 2888 2889 2890 | } else { /* * Path of form C:foo/bar, but this only makes sense if the cwd is * also on drive C. */ size_t cwdLen; | | | 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 | } else { /* * Path of form C:foo/bar, but this only makes sense if the cwd is * also on drive C. */ size_t cwdLen; const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen); char drive_cur = path[0]; if (drive_cur >= 'a') { drive_cur -= ('a' - 'A'); } if (drive[0] == drive_cur) { absolutePath = Tcl_DuplicateObj(useThisCwd); |
︙ | ︙ | |||
3057 3058 3059 3060 3061 3062 3063 | * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl, * so incr refCount here */ Tcl_IncrRefCount(validPathPtr); } | | | 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 | * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl, * so incr refCount here */ Tcl_IncrRefCount(validPathPtr); } str = Tcl_GetStringFromObj(validPathPtr, &len); if (strlen(str) != len) { /* * String contains NUL-bytes. This is invalid. */ goto done; |
︙ | ︙ | |||
3093 3094 3095 3096 3097 3098 3099 | */ wp = nativePathPtr = (WCHAR *)Tcl_Alloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { goto done; } MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, | | > | 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 | */ wp = nativePathPtr = (WCHAR *)Tcl_Alloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { goto done; } MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len + 2); nativePathPtr[len] = 0; /* * If path starts with "//?/" or "\\?\" (extended path), translate any * slashes to backslashes but leave the '?' intact */ if ((str[0] == '\\' || str[0] == '/') && (str[1] == '\\' || str[1] == '/') |
︙ | ︙ | |||
3241 3242 3243 3244 3245 3246 3247 | */ fileHandle = CreateFileW(native, FILE_WRITE_ATTRIBUTES, 0, NULL, OPEN_EXISTING, flags, NULL); if (fileHandle == INVALID_HANDLE_VALUE || !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) { | | | 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 | */ 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.
1 2 3 4 5 | /* * tclWinInit.c -- * * Contains the Windows-specific interpreter initialization functions. * | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclWinInit.c -- * * Contains the Windows-specific interpreter initialization functions. * * Copyright © 1994-1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. * All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" |
︙ | ︙ | |||
73 74 75 76 77 78 79 | #define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 10 #endif #ifndef PROCESSOR_ARCHITECTURE_UNKNOWN #define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF #endif | < < < < < | | | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 | #define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 10 #endif #ifndef PROCESSOR_ARCHITECTURE_UNKNOWN #define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF #endif /* * The following arrays contain the human readable strings for the * processor values. */ #define NUMPROCESSORS 15 static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "amd64", "ia32_on_win64", "neutral", "arm64", "arm32_on_win64", "ia32_on_arm64" }; /* * The default directory in which the init.tcl file is expected to be found. */ static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir; |
︙ | ︙ | |||
127 128 129 130 131 132 133 | */ void TclpInitPlatform(void) { WSADATA wsaData; WORD wVersionRequested = MAKEWORD(2, 2); | < < < < < < < < < | 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 | */ void TclpInitPlatform(void) { WSADATA wsaData; WORD wVersionRequested = MAKEWORD(2, 2); tclPlatform = TCL_PLATFORM_WINDOWS; /* * Initialize the winsock library. On Windows XP and higher this * can never fail. */ WSAStartup(wVersionRequested, &wsaData); #ifdef STATIC_BUILD /* * If we are in a statically linked executable, then we need to explicitly * initialize the Windows function tables here since DllMain() will not be * invoked. */ TclWinInit(GetModuleHandleW(NULL)); #endif } /* *------------------------------------------------------------------------- * * TclpInitLibraryPath -- * |
︙ | ︙ | |||
219 220 221 222 223 224 225 | * Look for the library in its source checkout location. */ Tcl_ListObjAppendElement(NULL, pathPtr, TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; | | | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | * Look for the library in its source checkout location. */ Tcl_ListObjAppendElement(NULL, pathPtr, TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; bytes = Tcl_GetStringFromObj(pathPtr, &length); *lengthPtr = length++; *valuePtr = (char *)Tcl_Alloc(length); memcpy(*valuePtr, bytes, length); Tcl_DecrRefCount(pathPtr); } /* |
︙ | ︙ | |||
344 345 346 347 348 349 350 | Tcl_Encoding *encodingPtr) { HMODULE hModule = (HMODULE)TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; | | | | 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 | Tcl_Encoding *encodingPtr) { HMODULE hModule = (HMODULE)TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; GetModuleFileNameW(hModule, wName, sizeof(wName)/sizeof(WCHAR)); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); end = strrchr(name, '\\'); *end = '\0'; p = strrchr(name, '\\'); if (p != NULL) { end = p; } |
︙ | ︙ | |||
392 393 394 395 396 397 398 | Tcl_Encoding *encodingPtr) { HMODULE hModule = (HMODULE)TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; | | | | 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 | Tcl_Encoding *encodingPtr) { HMODULE hModule = (HMODULE)TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; GetModuleFileNameW(hModule, wName, sizeof(wName)/sizeof(WCHAR)); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); end = strrchr(name, '\\'); *end = '\0'; p = strrchr(name, '\\'); if (p != NULL) { end = p; } |
︙ | ︙ |
Changes to win/tclWinInt.h.
︙ | ︙ | |||
27 28 29 30 31 32 33 | struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); void *ebp; void *esp; int status; } TCLEXCEPTION_REGISTRATION; #endif | < < < < < < < < < | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); void *ebp; void *esp; int status; } TCLEXCEPTION_REGISTRATION; #endif /* * Declarations of functions that are not accessible by way of the * stubs table. */ MODULE_SCOPE char TclWinDriveLetterForVolMountPoint( const WCHAR *mountPoint); |
︙ | ︙ |
Changes to win/tclWinLoad.c.
1 2 3 4 5 6 7 | /* * tclWinLoad.c -- * * This function provides a version of the TclLoadFile that works with * the Windows "LoadLibrary" and "GetProcAddress" API for dynamic * loading. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclWinLoad.c -- * * This function provides a version of the TclLoadFile that works with * the Windows "LoadLibrary" and "GetProcAddress" API for dynamic * loading. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" |
︙ | ︙ | |||
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: | | | 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 | " 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; } |
︙ | ︙ | |||
254 255 256 257 258 259 260 | * that represents the loaded file. */ { HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; FreeLibrary(hInstance); Tcl_Free(loadHandle); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 | * that represents the loaded file. */ { HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; FreeLibrary(hInstance); Tcl_Free(loadHandle); } /* *---------------------------------------------------------------------- * * TclpTempFileNameForLibrary -- * * Constructs a temporary file name for loading a shared object (DLL). |
︙ | ︙ | |||
403 404 405 406 407 408 409 | lastError = GetLastError(); if (lastError != ERROR_ALREADY_EXISTS) { break; } id *= 16777619; } | | | 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 | 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.
1 2 3 4 5 6 7 | /* * tclWinNotify.c -- * * This file contains Windows-specific procedures for the notifier, which * is the lowest-level part of the Tcl event loop. This file works * together with ../generic/tclNotify.c. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclWinNotify.c -- * * This file contains Windows-specific procedures for the notifier, which * is the lowest-level part of the Tcl event loop. This file works * together with ../generic/tclNotify.c. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
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 | * 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 = (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, (HINSTANCE) 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, (HINSTANCE) 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); } } /* *---------------------------------------------------------------------- * * NotifierProc -- |
︙ | ︙ | |||
417 418 419 420 421 422 423 | Tcl_ServiceAll(); return 0; } /* *---------------------------------------------------------------------- * | | | < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | 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 | Tcl_ServiceAll(); return 0; } /* *---------------------------------------------------------------------- * * 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. */ | | | | 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 | 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/tclWinPanic.c.
1 2 3 4 5 | /* * tclWinPanic.c -- * * Contains the Windows-specific command-line panic proc. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclWinPanic.c -- * * Contains the Windows-specific command-line panic proc. * * Copyright © 2013 Jan Nijtmans. * All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ |
Changes to win/tclWinPipe.c.
1 2 3 4 5 6 | /* * tclWinPipe.c -- * * This file implements the Windows-specific exec pipeline functions, the * "pipe" channel driver, and the "pid" Tcl command. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclWinPipe.c -- * * This file implements the Windows-specific exec pipeline functions, the * "pipe" channel driver, and the "pid" Tcl command. * * Copyright © 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" |
︙ | ︙ | |||
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()); Tcl_Free(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; |
︙ | ︙ | |||
3208 3209 3210 3211 3212 3213 3214 | namePtr = (char *) name; length = GetTempPathW(MAX_PATH, name); if (length == 0) { goto gotError; } namePtr += length * sizeof(WCHAR); if (basenameObj) { | | | 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 | namePtr = (char *) name; length = GetTempPathW(MAX_PATH, name); if (length == 0) { goto gotError; } namePtr += length * sizeof(WCHAR); if (basenameObj) { const char *string = Tcl_GetStringFromObj(basenameObj, &length); Tcl_DStringInit(&buf); Tcl_UtfToWCharDString(string, length, &buf); memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); namePtr += Tcl_DStringLength(&buf); Tcl_DStringFree(&buf); } else { |
︙ | ︙ | |||
3257 3258 3259 3260 3261 3262 3263 | TclDecrRefCount(tmpObj); } return Tcl_MakeFileChannel((ClientData) handle, TCL_READABLE|TCL_WRITABLE); gotError: | | | 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 | TclDecrRefCount(tmpObj); } return Tcl_MakeFileChannel((ClientData) handle, TCL_READABLE|TCL_WRITABLE); gotError: Tcl_WinConvertError(GetLastError()); return NULL; } /* *---------------------------------------------------------------------- * * TclPipeThreadCreateTI -- |
︙ | ︙ | |||
3571 3572 3573 3574 3575 3576 3577 | SetEvent(evControl); /* * Cancel all sync-IO of this thread (may be blocked there). */ | < | < | 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 | SetEvent(evControl); /* * Cancel all sync-IO of this thread (may be blocked there). */ CancelSynchronousIo(hThread); /* * Wait at most 20 milliseconds for the reader thread to close * (regarding TIP#398-fast-exit). */ /* |
︙ | ︙ |
Changes to win/tclWinPort.h.
︙ | ︙ | |||
22 23 24 25 26 27 28 | && !defined(MP_32BIT) && !defined(MP_64BIT) # define MP_64BIT #endif /* * We must specify the lower version we intend to support. * | | | | | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | && !defined(MP_32BIT) && !defined(MP_64BIT) # define MP_64BIT #endif /* * We must specify the lower version we intend to support. * * WINVER = 0x0601 means Windows 7 and above */ #ifndef WINVER # define WINVER 0x0601 #endif #ifndef _WIN32_WINNT # define _WIN32_WINNT 0x0601 #endif #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN /* Compatibility to older visual studio / windows platform SDK */ |
︙ | ︙ | |||
107 108 109 110 111 112 113 | * Need to block out these includes for building extensions with MetroWerks * compiler for Win32. */ #ifndef __MWERKS__ #include <sys/stat.h> #include <sys/timeb.h> | < < < | < | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | * Need to block out these includes for building extensions with MetroWerks * compiler for Win32. */ #ifndef __MWERKS__ #include <sys/stat.h> #include <sys/timeb.h> #include <sys/utime.h> #endif /* __MWERKS__ */ /* * The following defines redefine the Windows Socket errors as * BSD errors so Tcl_PosixError can do the right thing. */ |
︙ | ︙ | |||
450 451 452 453 454 455 456 | * Visual C++ has some odd names for common functions, so we need to * define a few macros to handle them. Also, it defines EDEADLOCK and * EDEADLK as the same value, which confuses Tcl_ErrnoId(). */ #if defined(_MSC_VER) || defined(__MSVCRT__) # define environ _environ | < < < | < < < < < < < < < < < < < < < < < < < < < < | | < | 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 | * Visual C++ has some odd names for common functions, so we need to * define a few macros to handle them. Also, it defines EDEADLOCK and * EDEADLK as the same value, which confuses Tcl_ErrnoId(). */ #if defined(_MSC_VER) || defined(__MSVCRT__) # define environ _environ # define exception _exception # undef EDEADLOCK # if defined(_MSC_VER) # define timezone _timezone # endif #endif /* _MSC_VER || __MSVCRT__ */ #if defined(_MSC_VER) # pragma warning(disable:4146) # pragma warning(disable:4244) #if !defined(_WIN64) # pragma warning(disable:4305) #endif # pragma warning(disable:4267) # pragma warning(disable:4996) #endif /* *--------------------------------------------------------------------------- * The following macros and declarations represent the interface between * generic and windows-specific parts of Tcl. Some of the macros may * override functions declared in tclInt.h. |
︙ | ︙ |
Changes to win/tclWinReg.c.
︙ | ︙ | |||
187 188 189 190 191 192 193 | if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { return TCL_ERROR; } cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); | | | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { return TCL_ERROR; } cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); return Tcl_PkgProvideEx(interp, "registry", "1.3.6", NULL); } /* *---------------------------------------------------------------------- * * Registry_Unload -- * |
︙ | ︙ |
Changes to win/tclWinSerial.c.
1 2 3 4 5 6 | /* * tclWinSerial.c -- * * This file implements the Windows-specific serial port functions, and * the "serial" channel driver. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclWinSerial.c -- * * This file implements the Windows-specific serial port functions, and * the "serial" channel driver. * * Copyright © 1999 Scriptics Corp. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * Serial functionality implemented by [email protected] */ |
︙ | ︙ | |||
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.
1 2 3 4 5 | /* * tclWinSock.c -- * * This file contains Windows-specific socket related code. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclWinSock.c -- * * This file contains Windows-specific socket related code. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * ----------------------------------------------------------------------- * The order and naming of functions in this file should minimize * the file diff to tclUnixSock.c. |
︙ | ︙ | |||
874 875 876 877 878 879 880 | /* * Check for error condition or underflow in non-blocking case. */ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING) || (error != WSAEWOULDBLOCK)) { | | | 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 | /* * 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 |
︙ | ︙ | |||
988 989 990 991 992 993 994 | CLEAR_BITS(statePtr->readyEvents, FD_WRITE); if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { *errorCodePtr = EWOULDBLOCK; written = -1; break; } } else { | | | 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 | 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 |
︙ | ︙ | |||
1056 1057 1058 1059 1060 1061 1062 | */ while (statePtr->sockets != NULL) { TcpFdList *thisfd = statePtr->sockets; statePtr->sockets = thisfd->next; if (closesocket(thisfd->fd) == SOCKET_ERROR) { | | | 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 | */ 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(); } Tcl_Free(thisfd); } } if (statePtr->addrlist != NULL) { |
︙ | ︙ | |||
1146 1147 1148 1149 1150 1151 1152 | /* * 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)) { | | | | 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 | /* * 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; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1217 1218 1219 1220 1221 1222 1223 | } if (boolVar) { val = TRUE; } rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { | | | 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 | } 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; } |
︙ | ︙ | |||
1239 1240 1241 1242 1243 1244 1245 | } if (!boolVar) { val = TRUE; } rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { | | | 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 | } 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; } |
︙ | ︙ | |||
1374 1375 1376 1377 1378 1379 1380 | } /* * Return error message. */ if (err) { | | | 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 | } /* * Return error message. */ if (err) { Tcl_WinConvertError(err); Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1); } } } return TCL_OK; } |
︙ | ︙ | |||
1444 1445 1446 1447 1448 1449 1450 | * 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) { | | | 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 | * 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; } |
︙ | ︙ | |||
1520 1521 1522 1523 1524 1525 1526 | if (found) { if (len) { return TCL_OK; } Tcl_DStringEndSublist(dsPtr); } else { if (interp) { | | | 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 | 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; } } |
︙ | ︙ | |||
1772 1773 1774 1775 1776 1777 1778 | SetEvent(tsdPtr->socketListLock); /* * Continue on socket creation error. */ if (statePtr->sockets->fd == INVALID_SOCKET) { | | | 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 | 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. */ |
︙ | ︙ | |||
1797 1798 1799 1800 1801 1802 1803 | /* * Try to bind to a local port. */ if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr, statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) { | | | 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 | /* * 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 */ |
︙ | ︙ | |||
1868 1869 1870 1871 1872 1873 1874 | * Attempt to connect to the remote socket. */ connect(statePtr->sockets->fd, statePtr->addr->ai_addr, statePtr->addr->ai_addrlen); error = WSAGetLastError(); | | | 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 | * 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 */ |
︙ | ︙ | |||
1900 1901 1902 1903 1904 1905 1906 | WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Get signaled connect error. */ | | | 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 | WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Get signaled connect error. */ Tcl_WinConvertError((DWORD) statePtr->notifierConnectError); /* * Clear eventual connect flag. */ CLEAR_BITS(statePtr->selectEvents, FD_CONNECT); |
︙ | ︙ | |||
2229 2230 2231 2232 2233 2234 2235 | 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) { | | | 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 | 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. */ |
︙ | ︙ | |||
2280 2281 2282 2283 2284 2285 2286 | * 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) { | | | 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 | * 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); |
︙ | ︙ | |||
2305 2306 2307 2308 2309 2310 2311 | /* * 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) { | | | 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 | /* * 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. |
︙ | ︙ | |||
2490 2491 2492 2493 2494 2495 2496 | windowClass.lpszMenuName = NULL; windowClass.lpszClassName = className; windowClass.lpfnWndProc = SocketProc; windowClass.hIcon = NULL; windowClass.hCursor = NULL; if (!RegisterClassW(&windowClass)) { | | | 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 | 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.
1 2 3 4 5 | /* * tclWinTest.c -- * * Contains commands for platform specific tests on Windows. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclWinTest.c -- * * Contains commands for platform specific tests on Windows. * * Copyright © 1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS |
︙ | ︙ | |||
202 203 204 205 206 207 208 | } 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); | | | 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 | } 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/tclWinThrd.c.
1 2 3 4 5 | /* * tclWinThread.c -- * * This file implements the Windows-specific thread operations. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * tclWinThread.c -- * * This file implements the Windows-specific thread operations. * * Copyright © 1998 Sun Microsystems, Inc. * Copyright © 1999 Scriptics Corporation * Copyright © 2008 George Peter Staplin * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" |
︙ | ︙ | |||
218 219 220 221 222 223 224 | EnterCriticalSection(&joinLock); *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and * on WIN64 sizeof void* != sizeof unsigned */ | | | 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 | EnterCriticalSection(&joinLock); *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and * on WIN64 sizeof void* != sizeof unsigned */ #if defined(_MSC_VER) || defined(__MSVCRT__) tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr, 0, (unsigned *)idPtr); #else tHandle = CreateThread(NULL, (DWORD) stackSize, TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr); #endif |
︙ | ︙ | |||
296 297 298 299 300 301 302 | TclpThreadExit( int status) { EnterCriticalSection(&joinLock); TclSignalExitThread(Tcl_GetCurrentThread(), status); LeaveCriticalSection(&joinLock); | | | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 | TclpThreadExit( int status) { EnterCriticalSection(&joinLock); TclSignalExitThread(Tcl_GetCurrentThread(), status); LeaveCriticalSection(&joinLock); #if defined(_MSC_VER) || defined(__MSVCRT__) _endthreadex((unsigned) status); #else ExitThread((DWORD) status); #endif } /* |
︙ | ︙ |
Changes to win/tclWinTime.c.
1 2 3 4 5 6 | /* * tclWinTime.c -- * * Contains Windows specific versions of Tcl functions that obtain time * values from the operating system. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | /* * tclWinTime.c -- * * Contains Windows specific versions of Tcl functions that obtain time * values from the operating system. * * Copyright © 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
24 25 26 27 28 29 30 | 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. */ | | > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | 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. */ |
︙ | ︙ | |||
54 55 56 57 58 59 60 | LARGE_INTEGER posixEpoch; /* Posix epoch expressed as 100-ns ticks since * the windows epoch. */ /* * Data used in developing the estimate of performance counter frequency */ | | | | | | | | > | | | | | > > > > > > > > > > > > > > > > > | | > | > | | < | | | 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 | LARGE_INTEGER posixEpoch; /* Posix epoch expressed as 100-ns ticks since * the windows epoch. */ /* * Data used in developing the estimate of performance counter frequency */ unsigned long long fileTimeSample[SAMPLES]; /* Last 64 samples of system time. */ long long perfCounterSample[SAMPLES]; /* Last 64 samples of performance counter. */ int sampleNo; /* Current sample number. */ } TimeInfo; static TimeInfo timeInfo = { { NULL, 0, 0, NULL, NULL, 0 }, 0, 0, 1, (HANDLE) NULL, (HANDLE) NULL, (HANDLE) NULL, #if defined(HAVE_CAST_TO_UNION) && !defined(__cplusplus) (LARGE_INTEGER) (long long) 0, (ULARGE_INTEGER) (DWORDLONG) 0, (LARGE_INTEGER) (long long) 0, (LARGE_INTEGER) (long long) 0, (LARGE_INTEGER) (long long) 0, #else {0, 0}, {0, 0}, {0, 0}, {0, 0}, {0, 0}, #endif { 0 }, { 0 }, 0 }; /* * Scale to convert wide click values from the TclpGetWideClicks native * resolution to microsecond resolution and back. */ static struct { int initialized; /* 1 if initialized, 0 otherwise */ int perfCounter; /* 1 if performance counter usable for wide * clicks */ double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0, 0.0}; /* * Declarations for functions defined later in this file. */ static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); static void ResetCounterSamples(unsigned long long fileTime, long long perfCounter, long long perfFreq); static long long AccumulateSample(long long perfCounter, unsigned long long fileTime); static void NativeScaleTime(Tcl_Time* timebuf, ClientData clientData); static long long NativeGetMicroseconds(void); static void NativeGetTime(Tcl_Time* timebuf, ClientData clientData); /* * 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 * Unix systems the epoch is Midnight Jan 1, 1970 GMT. * * Results: * Number of seconds from the epoch. * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned long 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 (unsigned long long)(unsigned long) t.sec; } } /* *---------------------------------------------------------------------- * * TclpGetClicks -- |
︙ | ︙ | |||
177 178 179 180 181 182 183 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | > | > | | < | | > | | 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 | * * Side effects: * None. * *---------------------------------------------------------------------- */ unsigned long long TclpGetClicks(void) { long long usecSincePosixEpoch; /* * Try to use high resolution timer. */ if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { return (Tcl_WideUInt) 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 long)(unsigned long) now.sec * 1000000ULL) + now.usec; } } /* *---------------------------------------------------------------------- * * TclpGetWideClicks -- |
︙ | ︙ | |||
219 220 221 222 223 224 225 | * This should be used for time-delta resp. for measurement purposes * only, because on some platforms can return microseconds from some * start time (not from the epoch). * *---------------------------------------------------------------------- */ | | > | | 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 | * This should be used for time-delta resp. for measurement purposes * only, because on some platforms can return microseconds from some * start time (not from the epoch). * *---------------------------------------------------------------------- */ long long TclpGetWideClicks(void) { LARGE_INTEGER curCounter; if (!wideClick.initialized) { LARGE_INTEGER perfCounterFreq; /* * The frequency of the performance counter is fixed at system boot and * is consistent across all processors. Therefore, the frequency need * only be queried upon application initialization. */ if (QueryPerformanceFrequency(&perfCounterFreq)) { wideClick.perfCounter = 1; wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart; } else { /* fallback using microseconds */ wideClick.perfCounter = 0; wideClick.microsecsScale = 1; } wideClick.initialized = 1; } if (wideClick.perfCounter) { if (QueryPerformanceCounter(&curCounter)) { return (long long)curCounter.QuadPart; } /* fallback using microseconds */ wideClick.perfCounter = 0; wideClick.microsecsScale = 1; return TclpGetMicroseconds(); } else { return TclpGetMicroseconds(); |
︙ | ︙ | |||
278 279 280 281 282 283 284 | *---------------------------------------------------------------------- */ double TclpWideClickInMicrosec(void) { if (!wideClick.initialized) { | | | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | *---------------------------------------------------------------------- */ double TclpWideClickInMicrosec(void) { if (!wideClick.initialized) { (void) TclpGetWideClicks(); /* initialize */ } return wideClick.microsecsScale; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
300 301 302 303 304 305 306 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | > | > | | < | | | | | | 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 | * * Side effects: * None. * *---------------------------------------------------------------------- */ 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 -- |
︙ | ︙ | |||
349 350 351 352 353 354 355 | *---------------------------------------------------------------------- */ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { | | > | > | | < | | 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 | *---------------------------------------------------------------------- */ 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 -- |
︙ | ︙ | |||
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 | * Native scale is 1:1. Nothing is done. */ } /* *---------------------------------------------------------------------- * * NativeGetMicroseconds -- * * Gets the current system time in microseconds since the beginning * of the epoch: 00:00 UCT, January 1, 1970. * * Results: * Returns the wide integer with number of microseconds from the epoch, or * 0 if high resolution timer is not available. * * Side effects: * On the first call, initializes a set of static variables to keep track * of the base value of the performance counter, the corresponding wall * clock (obtained through ftime) and the frequency of the performance * counter. Also spins a thread whose function is to wake up periodically * and monitor these values, adjusting them as necessary to correct for * drift in the performance counter's oscillator. * *---------------------------------------------------------------------- */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | < > | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 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 | * 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 * 0 if high resolution timer is not available. * * Side effects: * On the first call, initializes a set of static variables to keep track * of the base value of the performance counter, the corresponding wall * clock (obtained through ftime) and the frequency of the performance * counter. Also spins a thread whose function is to wake up periodically * and monitor these values, adjusting them as necessary to correct for * drift in the performance counter's oscillator. * *---------------------------------------------------------------------- */ static 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); |
︙ | ︙ | |||
546 547 548 549 550 551 552 | /* * Query the performance counter and use it to calculate the current * time. */ ULONGLONG fileTimeLastCall; LONGLONG perfCounterLastCall, curCounterFreq; | | | > > > | > > | < > | > > | > > | 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 | /* * 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; } /* *---------------------------------------------------------------------- * * NativeGetTime -- |
︙ | ︙ | |||
619 620 621 622 623 624 625 | */ static void NativeGetTime( Tcl_Time *timePtr, TCL_UNUSED(ClientData)) { | | > | > | | | | 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 | */ static void NativeGetTime( Tcl_Time *timePtr, 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; } } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
718 719 720 721 722 723 724 | */ GetSystemTimeAsFileTime(&curFileTime); QueryPerformanceCounter(&timeInfo.perfCounterLastCall); QueryPerformanceFrequency(&timeInfo.curCounterFreq); timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime; timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime; | > > | > > | 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 | */ 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); /* |
︙ | ︙ | |||
778 779 780 781 782 783 784 | static void UpdateTimeEachSecond(void) { LARGE_INTEGER curPerfCounter; /* Current value returned from * QueryPerformanceCounter. */ FILETIME curSysTime; /* Current system time. */ | | > | | | | | > > | > | | | < > | > > | 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 | 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; /* |
︙ | ︙ | |||
838 839 840 841 842 843 844 | * the first case). Our estimated frequency will be the nominal frequency. * * Store the current sample into the circular buffer of samples, and * estimate the performance counter frequency. */ estFreq = AccumulateSample(curPerfCounter.QuadPart, | | | | > > | > > > | > > > | | | > > | > > | > > | | | | | | | > > | | | | | > | > | > > > > > | > > > > | > > > | > > > | > > > | > > | 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 | * the first case). Our estimated frequency will be the nominal frequency. * * Store the current sample into the circular buffer of samples, and * estimate the performance counter frequency. */ estFreq = AccumulateSample(curPerfCounter.QuadPart, (unsigned long long) curFileTime.QuadPart); /* * We want to adjust things so that time appears to be continuous. * Virtual file time, right now, is * * vt0 = 10000000 * (curPerfCounter - perfCounterLastCall) * / curCounterFreq * + fileTimeLastCall * * Ideally, we would like to drift the clock into place over a period of 2 * sec, so that virtual time 2 sec from now will be * * 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; |
︙ | ︙ | |||
963 964 965 966 967 968 969 | * given frequency. * *---------------------------------------------------------------------- */ static void ResetCounterSamples( | | | | | > | 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 | * 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; } |
︙ | ︙ | |||
1003 1004 1005 1006 1007 1008 1009 | * * In either case, we'll need to reinitialize the circular buffer with samples * relative to the current system time and the NOMINAL performance frequency * (not the actual, because the actual has probably run slow in the first * case). */ | | | | > | | > | | | | | | 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 | * * In either case, we'll need to reinitialize the circular buffer with samples * relative to the current system time and the NOMINAL performance frequency * (not the actual, because the actual has probably run slow in the first * case). */ 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 = |
︙ | ︙ | |||
1050 1051 1052 1053 1054 1055 1056 | */ workPCSample = timeInfo.perfCounterSample[timeInfo.sampleNo]; workFTSample = timeInfo.fileTimeSample[timeInfo.sampleNo]; estFreq = 10000000 * (perfCounter - workPCSample) / (fileTime - workFTSample); timeInfo.perfCounterSample[timeInfo.sampleNo] = perfCounter; | | | 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 | */ workPCSample = timeInfo.perfCounterSample[timeInfo.sampleNo]; workFTSample = timeInfo.fileTimeSample[timeInfo.sampleNo]; estFreq = 10000000 * (perfCounter - workPCSample) / (fileTime - workFTSample); timeInfo.perfCounterSample[timeInfo.sampleNo] = perfCounter; timeInfo.fileTimeSample[timeInfo.sampleNo] = (long long) fileTime; /* * Advance the sample number. */ if (++timeInfo.sampleNo >= SAMPLES) { timeInfo.sampleNo = 0; |
︙ | ︙ |
Changes to win/tclsh.exe.manifest.in.
︙ | ︙ | |||
24 25 26 27 28 29 30 | <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/> <!-- Windows 8.1 --> <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> <!-- Windows 8 --> <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/> <!-- Windows 7 --> <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/> | < < | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/> <!-- Windows 8.1 --> <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> <!-- Windows 8 --> <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/> <!-- Windows 7 --> <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/> </application> </compatibility> <asmv3:application> <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings"> <dpiAware>true</dpiAware> </asmv3:windowsSettings> |
︙ | ︙ |