Tcl Source Code

Changes On Branch rfe-854941
Login

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
10
11
12
13
14
15
16
17
18
19
20
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.hpj.in
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
win/tcl.hpj.in









<









<
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
8
9
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in
<







<

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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
    - name: "Linux/GCC/Mem-Debug"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols=mem"
# C++ build.
    - name: "Linux/G++/Shared"
      os: linux
      dist: focal
      compiler: g++
      env:
        - BUILD_DIR=unix
        - CFGOPT="CC=g++ CFLAGS=-Dregister=dont+use+register"
# Newer/Older versions of GCC
    - name: "Linux/GCC 10/Shared"
      os: linux
      dist: focal
      compiler: gcc-10
      addons:
        apt:







<
<
<
<
<
<
<
<







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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
        - BUILD_DIR=macosx
      install: []
      script: *mactest
      addons:
        homebrew:
          packages:
            - libtommath
    - name: "macOS/Clang++/Xcode 12/Shared"
      os: osx
      osx_image: xcode12.2
      env:
        - BUILD_DIR=unix
        - CFGOPT="CC=clang++ --enable-framework --enable-dtrace CFLAGS=-Dregister=dont+use+register CPPFLAGS=-D__private_extern__=extern"
      script:
        - make all tcltest
# Newer MacOS versions
    - name: "macOS/Clang/Xcode 12/Universal Apps/Shared"
      os: osx
      osx_image: xcode12u
      env:
        - BUILD_DIR=macosx
      install: []







<
<
<
<
<
<
<
<







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
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
    - 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
        - rm -rf tests/safe-stock8*.test
        - 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 'OPTS=nodep' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=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,msvcrt' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
    - name: "Windows/MSVC/Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:







<














|
|







|
|







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
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
    - 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 'OPTS=nodep' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=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,msvcrt' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Debug"
      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
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
    - name: "Windows/GCC/Shared"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit"
      before_install: &makepreinst
        - rm -rf tests/safe-stock8*.test
        - 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/G++/Shared"
      os: windows
      compiler: g++
      env:
        - BUILD_DIR=win
        - CFGOPT="CC=g++ --enable-64bit"
      before_install: *makepreinst
      script:
        - make all tcltest
    - name: "Windows/GCC/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit --disable-shared"
      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
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
    - 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/G++-x86/Shared"
      os: windows
      compiler: g++
      env:
        - BUILD_DIR=win
        - CFGOPT="CC=g++"
      before_install: *makepreinst
      script:
        - make all tcltest
    - name: "Windows/GCC-x86/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--disable-shared"
      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
427
428
429
430
431
432
433
434
435
436
437
438
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
      script:
        - make dist
before_install:
  - rm -rf tests/safe-stock8*.test
  - 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







<











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











8


9
10
11
12
13
14
15
# 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/).












[![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=master)](https://travis-ci.org/tcltk/tcl)



## Contents
 1. [Introduction](#intro)
 2. [Documentation](#doc)
 3. [Compiling and installing Tcl](#build)
 4. [Development tools](#devtools)
 5. [Tcl newsgroup](#complangtcl)







>
>
>
>
>
>
>
>
>
>
>
|
>
>







1
2
3
4
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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
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
takes 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 at 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







|





|





|







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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
## <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 news group, "`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.







|


|





|







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
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29



30
31
32
33
34
35


36
37
38
39
40
41
42
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc \- 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)



.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.


.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






|



|


















>
>
>






>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
40
41

42
43
44
45
46
47
48
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 int *lengthPtr out
If non-NULL, filled with the length of the array of bytes in the value.

.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







|
|
>







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
232
233
234
235
236
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"
interp

.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
parent, child







>
>
>
>
>
>
>
>

|




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

256
257
258
259
260
261
262
263
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.  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







>
|







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
764
765
766
767
768
769
770
771
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,
        Tcl_WideInt \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.







|







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
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 by 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



|







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
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 2000 by 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

|
|







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
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, int recursive, errorPtr\fR)
.sp
int
\fBTcl_FSRenameFile\fR(\fIsrcPathPtr, destPathPtr\fR)
.sp
Tcl_Obj *
\fBTcl_FSListVolumes\fR(\fIvoid\fR)
.sp







|







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
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, int index, pathPtr, objPtrRef\fR)
.sp
int
\fBTcl_FSFileAttrsSet\fR(\fIinterp, int index, pathPtr, Tcl_Obj *objPtr\fR)
.sp
const char *const *
\fBTcl_FSFileAttrStrings\fR(\fIpathPtr, objPtrRef\fR)
.sp
int
\fBTcl_FSStat\fR(\fIpathPtr, statPtr\fR)
.sp







|


|







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
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
.sp
Tcl_Obj *
\fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR)
.sp
Tcl_StatBuf *
\fBTcl_AllocStatBuf\fR()
.sp
Tcl_WideInt
\fBTcl_GetAccessTimeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetBlockSizeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideUInt
\fBTcl_GetBlocksFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideInt
\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
Tcl_WideInt
\fBTcl_GetModificationTimeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideUInt
\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 "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







|





|


|




















|


|



















>
>







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
244
245
246
247
248
249
250
251
252
253
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
.AP Tcl_PackageInitProc **proc1Ptr out
Filled with the init function for this code.
.AP Tcl_PackageInitProc **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







>
>
>
>

















|

|







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
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
void
\fBTcl_FindExecutable\fR(\fIargv0\fR)
.sp
const char *
\fBTcl_GetNameOfExecutable\fR()
.SH ARGUMENTS
.AS char *argv0
.AP char *argv0 in







|







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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 by 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

|







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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1996 by Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS

|







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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2001 by 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

|







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
2
3
4
5
6
7
8
9
10
11
12
13
14
15



16
17
18
19


20
21
22
23
24
25
26
27
28











29
30
31
32
33
34
'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_Init 3 8.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)



.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Interpreter to initialize.


.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.












.SH "SEE ALSO"
Tcl_AppInit, Tcl_Main

.SH KEYWORDS
application, initialization, interpreter

|


|










>
>
>




>
>









>
>
>
>
>
>
>
>
>
>
>






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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
void
\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







|







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
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, \fB__int64\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.







|







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
262
263
264
265
266
267
268
269
.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"
Class(3), oo::class(n), oo::define(n), oo::object(n)
.SH KEYWORDS
constructor, method, object

.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|







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
2
3
4
5
6
7
8
9
10
.\"
.\" Copyright (c) 2008 by Kevin B. Kenny.
.\" Copyright (c) 2018 by 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

|
|







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
235
236
    return result;
}
.CE
.PP
Any function comprising a routine can push other functions, making it possible
implement looping and sequencing constructs using the function stack.
.PP



















.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright (c) 2008 by Kevin B. Kenny.
Copyright (c) 2018 by Nathan Coulter.







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|
|
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
    return result;
}
.CE
.PP
Any function comprising a routine can push other functions, making it possible
implement looping and sequencing constructs using the function stack.
.PP
.SH "REFERENCE COUNT MANAGEMENT"
.PP
The first \fIobjc\fR values in the \fIobjv\fR array passed to the functions
\fBTcl_NRCallObjProc\fR, \fBTcl_NREvalObjv\fR, and \fBTcl_NRCmdSwap\fR should
have a reference count of at least 1; they may have additional references
taken during the execution.
.PP
The \fIobjPtr\fR argument to \fBTcl_NREvalObj\fR and \fBTcl_NRExprObj\fR
should have a reference count of at least 1, and may have additional
references taken to it during execution.
.PP
The \fIresultObj\fR argument to \fBTcl_NRExprObj\fR should be an unshared
object.
.PP
Use \fBTcl_NRAddCallback\fR to schedule any required final decrementing of the
reference counts of arguments to any of the other functions on this page, as
with any other post-processing step in the non-recursive execution engine.
.PP
The
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright \(co 2008 Kevin B. Kenny.
Copyright \(co 2018 Nathan Coulter.

Changes to doc/Namespace.3.

42
43
44
45
46
47
48
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(\fIinterp, nsPtr\fR)
.sp
int
\fBTcl_SetNamespaceUnknownHandler(\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.







|


|







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
286





287
288
289
290
291
292
293
.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.





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.







|
>
>
>
>
>







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
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
Tcl_WideInt
\fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
.sp
Tcl_WideInt
\fBTcl_Tell\fR(\fIchannel\fR)
.sp
int
\fBTcl_TruncateChannel\fR(\fIchannel, length\fR)
.sp
int
\fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR)







|


|







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
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 Tcl_WideInt 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 Tcl_WideInt 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.







|







|







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
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
void
\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







|







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
97
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"
package(n), Tcl_StaticPackage(3)







>
>
>
>



|
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
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 binary 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 binary library and the generation of a
Tcl-level interface for querying this information.
.PP
To embed configuration information into their binary 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,







|











|


|







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
111
    const char *\fIkey\fR;
    const char *\fIvalue\fR;
} \fBTcl_Config\fR;
.CE
.\" No cross references yet.
.\" .SH "SEE ALSO"
.SH KEYWORDS
embedding, configuration, binary library







|
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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1997 by 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"

|







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
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.
.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 current 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 \fBbypass 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







|






|





|







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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 by 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

|







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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
'\"
'\" 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_StaticPackage 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_StaticPackage \- make a statically linked package available via the 'load' command
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_StaticPackage\fR(\fIinterp, pkgName, initProc, safeInitProc\fR)
.SH ARGUMENTS
.AS Tcl_PackageInitProc *safeInitProc
.AP Tcl_Interp *interp in
If not NULL, points to an interpreter into which the package has
already been loaded (i.e., the caller has already invoked the
appropriate initialization procedure).  NULL means the package
has not yet been incorporated into any interpreter.
.AP "const char" *pkgName in
Name of the package;  should be properly capitalized (first letter
upper-case, all others lower-case).
.AP Tcl_PackageInitProc *initProc in
Procedure to invoke to incorporate this package into a trusted
interpreter.
.AP Tcl_PackageInitProc *safeInitProc in
Procedure to call to incorporate this package into a safe interpreter
(one that will execute untrusted scripts).  NULL means the package
cannot be used in safe interpreters.
.BE
.SH DESCRIPTION
.PP
This procedure may be invoked to announce that a package has been
linked statically with a Tcl application and, optionally, that it
has already been loaded into an interpreter.
Once \fBTcl_StaticPackage\fR has been invoked for a package, it
may be loaded into interpreters using the \fBload\fR command.
\fBTcl_StaticPackage\fR is normally invoked only by the \fBTcl_AppInit\fR
procedure for the application, not by packages for themselves
(\fBTcl_StaticPackage\fR should only be invoked for statically
loaded packages, and code in the package itself should not need
to know whether the package is dynamically or statically loaded).
.PP
When the \fBload\fR command is used later to load the package 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_PackageInitProc\fR(
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the package
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 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_StaticPackage\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)
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































































Changes to doc/StdChannels.3.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2001 by 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

|







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
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 int *lengthPtr out
If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
the length of a value's string representation.
.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.







|
|
|







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
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 2000 by 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

|
|







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
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 its 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







|







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
9
10
11
12
13
14
15
16
17
18
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
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Main, Tcl_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_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 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.


.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








|



|






>
>
>
>













>
>
>
>












>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS

|







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
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
\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, 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.

.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 - \fBTCL_UTF_MAX\fR).  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[-\fBTCL_UTF_MAX\fI-1]\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.







|
|
|
|




















|
>
















|




|







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
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 TclOO

\fBoo::abstract\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR







|







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
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Copyright (c) 2008 by Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

|
|







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
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 TclOO

\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR?
\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBcallback\fR command,







|







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
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







|












|







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
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 TclOO

\fBoo::class\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR







|







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
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 TclOO

\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;







|







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
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










|







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
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 (c) 2004 Kevin B. Kenny <[email protected]>. All rights reserved.
'\" Local Variables:
'\" mode: nroff
'\" End:







|



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
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 TclOO

\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







|







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
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 TclOO

\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







|







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
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 return 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







|







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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998 by 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

|







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
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
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
Additionally, when calling a 16-bit DOS or Windows 3.X application, all path
names must use the short, cryptic, path format (e.g., using
.QW applba~1.def
instead of
.QW applbakery.default ),
which can be obtained with the
.QW "\fBfile attributes\fI fileName \fB\-shortname\fR"
command.
.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







<
<
<
<
<
<
<
<
<







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
298
299
300
301
302
303
304
305
306
307
308
309
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 NT 32-bit system directory.
.IP \(bu 3
The Windows NT 16-bit system directory.
.IP \(bu 3
The Windows NT 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.







|

<
<
|







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
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 by 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



|







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
85
86
87
88
89
90
91
92
93
94
.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







|
|
|







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
271
272
273
274
275
276
277
278
.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]







|







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
507
508
509
510

511
.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.
Copyright \(co 2005 by Kevin B. Kenny <[email protected]>. All rights reserved.
.fi
'\" Local Variables:
'\" mode: nroff

'\" End:







>

>


















|



>

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
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
.







|











|

|







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
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
.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
flags and their values. The second form returns the value for the
specific 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 sets or retrieves the octal code that chmod(1)

uses.  This command does also has limited support for setting using the
symbolic attributes for chmod(1), of the form [ugo]?[[+\-=][rwxst],[...]],


where multiple symbolic attributes can be separated by commas (example:
\fBu+s,go\-rw\fR add sticky bit for user, remove read and write
permissions for group and other).  A simplified \fBls\fR style string,
of the form rwxrwxrwx (must be 9 characters), is also supported
(example: \fBrwxr\-xr\-t\fR is equivalent to 01755).
On versions of Unix supporting file flags, \fB\-readonly\fR gives the
value or sets or clears the readonly attribute of the file,
i.e. the user immutable flag \fBuchg\fR to chflags(1).

.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







|
|
|
|
|


|
|
|
|
|
>
|
<
>
>
|
|
|
|
|
|
|
|
>







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
153
154
155
156
157
158
159
160
161
162
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).  Also Windows 3.1 only supports file
names with a root of no more than 8 characters and an extension of no
more than 3 characters.
.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 .







|
<
<







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
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
'\"
'\" Copyright (c) 2018 by Kevin B. Kenny <[email protected]>. All rights reserved
'\" Copyright (c) 2019 by 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

|
|











|







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
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 by Kevin B. Kenny <[email protected]>. All rights reserved
.fi
'\" Local Variables:
'\" mode: nroff
'\" End:







|




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
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by 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


|







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



328
329
330
331
332
333
334
335
336
337
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 to the server. The \fIquery\fR must be an x-url-encoding
formatted query.  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







>
>
>
|
|
<







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
669
670
671
672
673
674
675
676
677
678
679
\fBposterror\fR
.
The error, if any, that occurred while writing
the post query data to the server.
.TP
\fBstatus\fR
.
Either \fBok\fR, for successful completion, \fBreset\fR for
user-reset, \fBtimeout\fR if a timeout occurred before the transaction
could complete, or \fBerror\fR for an error condition.  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
.







|
|
<
|







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
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 by 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



|







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
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 TclOO

\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







|







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
16
17
18
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
.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 packageName\fR
.br
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName 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 package 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.
\fIpackageName\fR is the name of the package, and is used to
compute the name of an initialization procedure.
\fIinterp\fR is the path name of the interpreter into which to load
the package (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
\fIpackageName\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 \fIpkg\fB_Init\fR, where \fIpkg\fR
is the same as \fIpackageName\fR except that the first letter is
converted to upper case and all other letters
are converted to lower case.  For example, if \fIpackageName\fR is
\fBfoo\fR or \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 \fIpkg\fB_SafeInit\fR
instead of \fIpkg\fB_Init\fR.
The \fIpkg\fB_SafeInit\fR function should be written carefully, so that it
initializes the safe interpreter only with partial functionality provided
by the package 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_PackageInitProc\fR(
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the
package 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
package. 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 packages that are statically
linked with the application, if those packages have been registered
by calling the \fBTcl_StaticPackage\fR procedure.
If \fIfileName\fR is an empty string, then \fIpackageName\fR must
be specified.
.PP
If \fIpackageName\fR is omitted or specified as an empty string,
Tcl tries to guess the name of the package.
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, and use any following
alphabetic and underline characters as the module name.
For example, the command \fBload libxyz4.2.so\fR uses the module
name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the
module name \fBlast\fR.
.PP
If \fIfileName\fR is an empty string, then \fIpackageName\fR must
be specified.
The \fBload\fR command first searches for a statically loaded package
(one that has been registered by calling the \fBTcl_StaticPackage\fR
procedure) by that name; if one is found, it is used.
Otherwise, the \fBload\fR command searches for a dynamically loaded
package by that name, and uses it if it is found.  If several
different files have been \fBload\fRed with different versions of
the package, 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 packageName 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







|

|





|



<
|

|








|

|
<
<
<
|



|
|
|

|





|




|











|



|
|
|
|


|
|
<
<
|
>
|
|
|
|
|

|

|
|


|

|







|







9
10
11
12
13
14
15
16
17
18
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
191
192
193
194
195
196
    }
}

# Now execute the command defined by the extension
foo
.CE
.SH "SEE ALSO"
info sharedlibextension, package(n), Tcl_StaticPackage(3), safe(n)
.SH KEYWORDS
binary code, dynamic library, load, safe interpreter, shared library
'\"Local Variables:
'\"mode: nroff
'\"End:







|





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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2018 by 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

|







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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2003 by 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

|







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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2006 by 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

|







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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2001 by 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

|







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
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 by 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



|











|







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
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 by Kevin B. Kenny <[email protected]>.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:







|





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
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













|







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
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1992-1999 by Karl Lehenbauer and Mark Diekhans
'\" Copyright (c) 2000 by 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

|
|







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
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













|







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
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.







|







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
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 TclOO

\fBmy\fI methodName\fR ?\fIarg ...\fR?
\fBmyclass\fI methodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
.PP







|







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
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 TclOO

\fBnext\fR ?\fIarg ...\fR?
\fBnextto\fI class\fR ?\fIarg ...\fR?
.fi
.BE

.SH DESCRIPTION







|







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
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 TclOO

\fBoo::object\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
.fi







|







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
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, all 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







|







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
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 by 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

|







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
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 binary 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







|







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
140


141
142
143
144













145
146
147
148
149
150
151
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 a line


.TP
\fB$\fR
.
matches at the end of a line













.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







|
>
>



|
>
>
>
>
>
>
>
>
>
>
>
>
>







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
296
297
298
299
300
301
302
303
304
305
306
307
308
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







|


|

|







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
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
.TP
\fB\es\fR
.
\fB[[:space:]]\fR
.TP
\fB\ew\fR
.
\fB[[:alnum:]_]\fR (note underscore)
.TP
\fB\eD\fR
.
\fB[^[:digit:]]\fR
.TP
\fB\eS\fR
.
\fB[^[:space:]]\fR
.TP
\fB\eW\fR
.
\fB[^[:alnum:]_]\fR (note underscore)
.RE
.PP
Within bracket expressions,
.QW \fB\ed\fR ,
.QW \fB\es\fR ,
and
.QW \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
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 TclOO

\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







|







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
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 TclOO

\fBoo::singleton\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR







|







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
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 by Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH socket n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS


|







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
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 CESU\-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.)







|







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
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







|







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
1182
1183
1184
1185
1186
1187
1188
1189
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 Tcl 8.6
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







<







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
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 packageName\fR
.br
\fBunload \fR?\fIswitches\fR? \fIfileName packageName 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 \fIpackageName\fR argument is the name of the package (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.







|

|








|







9
10
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
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
\fIpackageName\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 \fIpkg\fB_Unload\fR, where \fIpkg\fR
is the same as \fIpackageName\fR except that the first letter is
converted to upper case and all other letters
are converted to lower case.  For example, if \fIpackageName\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_PackageUnloadProc\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







|

|
|

|


















|







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
117
118
119
120
121
122
123
124

125
126
127
128
129
130
131
132
133
134
135
136
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 \fIpackageName\fR argument must
be specified.
.PP
If \fIpackageName\fR is omitted or specified as an empty string,
Tcl tries to guess the name of the package.
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, and use any following
alphabetic and underline characters as the module name.
For example, the command \fBunload libxyz4.2.so\fR uses the module
name \fBxyz\fR and the command \fBunload bin/last.so {}\fR uses the
module name \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).







|


|
|
|
|
|
>
|
|
|
|
|







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
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
int
\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)







|







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
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 a Tcl result code (e.g., \fBTCL_OK\fR
when the function is successful). 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







|
|







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
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 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?







|







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
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 ?\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







|







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
5
6
7
8
9
10
11
12
/*
 * colorings of characters
 * This file is #included by regcomp.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without




|







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
5
6
7
8
9
10
11
12
/*
 * Utility functions for handling cvecs
 * This file is #included by regcomp.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without




|







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
5
6
7
8
9
10
11
12
/*
 * lexical analyzer
 * This file is #included by regcomp.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without




|







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
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);
		RET('}');
	    } else {
		FAILW(REG_BADBR);
	    }
	    break;
	default:
	    FAILW(REG_BADBR);
	    break;







|







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
1008
1009
1010
1011
1012
1013
1014
1015
    chr c = (chr)pc;

    switch (c) {
    case CHR('*'):
	if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) {
	    RETV(PLAIN, c);
	}
	RET('*');
	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(']') &&







|







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
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 (c) 1998 by 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 */







|







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
5
6
7
8
9
10
11
12
/*
 * NFA utilities.
 * This file is #included by regcomp.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without




|







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
5
6
7
8
9
10
11
12
/*
 * re_*comp and friends - compile REs
 * This file #includes several others (see the bottom).
 *
 * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without




|







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
5
6
7
8
9
10
11
12
/*
 * DFA routines
 * This file is #included by regexec.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without




|







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
4
5
6
7
8
9
10
11
/*
 * regerror - error-code expansion
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without



|







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
4
5
6
7
8
9
10
11
/*
 * re_*exec and friends - match REs
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without



|







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
4
5
6
7
8
9
10
11
/*
 * regfree - free an RE
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without



|







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
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 (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without






|







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
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 (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# 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.

library tcl

# Define the tcl interface with several sub interfaces:







|
|
|







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
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 unix {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    void *clientData)
}
declare 10 unix {
    void Tcl_DeleteFileHandler(int fd)
}
declare 11 {
    void Tcl_SetTimer(const Tcl_Time *timePtr)
}
declare 12 {
    void Tcl_Sleep(int ms)







|



|







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
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 *Tcl_GetByteArrayFromObj(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)







|







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
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 *Tcl_GetStringFromObj(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)







|







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
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 unix {
    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)







|







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
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_StaticPackage(Tcl_Interp *interp, const char *pkgName,
#	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *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 {







|
|







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
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 Tcl_UtfCharComplete(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 *Tcl_UtfNext(const char *src)
}
declare 331 {
    const char *Tcl_UtfPrev(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)
}







|











|


|







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
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 *Tcl_GetUnicodeFromObj(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,







|







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
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_PackageInitProc **proc1Ptr,
	    Tcl_PackageInitProc **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 {







|
|







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
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 {
    Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode)
}
declare 492 {
    Tcl_WideInt Tcl_Tell(Tcl_Channel chan)
}

# TIP#91 (back-compat enhancements for channels) dkf
declare 493 {
    Tcl_DriverWideSeekProc *Tcl_ChannelWideSeekProc(
	    const Tcl_ChannelType *chanTypePtr)
}







|


|







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
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, Tcl_WideInt length)
}
declare 561 {
    Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc(
	    const Tcl_ChannelType *chanTypePtr)
}

# TIP#219 (channel reflection api) akupries







|







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
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 {
    Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 597 {
    Tcl_WideInt Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 598 {
    Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 599 {
    Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr)
}
declare 600 {
    Tcl_WideUInt 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 {







|


|


|


|


|







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
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
    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)

################################
# Windows specific functions

# Added in Tcl 8.1, Removed in Tcl 9.0 (converted to macro)

#declare 0 win {
#    TCHAR *Tcl_WinUtfToTChar(const char *str, size_t len, Tcl_DString *dsPtr)
#}
#declare 1 win {
#    char *Tcl_WinTCharToUtf(const TCHAR *str, size_t len, Tcl_DString *dsPtr)
#}

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

# Removed in 9.0
#declare 0 macosx {
#    int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
#	    const char *bundleName, int hasResourceFile,
#	    size_t maxPathLen, char *libraryPath)
#}
declare 1 macosx {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, size_t maxPathLen, char *libraryPath)
}










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

# 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_StaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
export {
    void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
export {
    Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}
export {
    void 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)
}




# Local Variables:
# mode: tcl
# End:







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>














<
<
<
<
<
<
<
<
<
<
<
<



<
<
<
<
<
<
|




>
>
>
>
>
>
>
>
>










|
|


|





|



















>
>
>




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
48
49
50
51
52
53
54
55
 * 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)
 * tools/tcl.hpj.in	(not patchlevel, for windows installer)
 */

#define TCL_MAJOR_VERSION   9
#define TCL_MINOR_VERSION   0
#define TCL_RELEASE_LEVEL   TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL  2








<







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



105

106
107
108
109
110
111
112
 * 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)



#   define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))

#   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)







>
>
>
|
>







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
152
153
154
155
156
157
158
159
160
 *
 * 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.
 */

#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
#   define HAVE_DECLSPEC 1
#   ifdef STATIC_BUILD
#       define DLLIMPORT
#       define DLLEXPORT
#       ifdef _DLL
#           define CRTIMPORT __declspec(dllimport)
#       else
#           define CRTIMPORT







<
|







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
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
/*
 * Darwin specific configure overrides (to support fat compiles, where
 * configure runs only once for multiple architectures):
 */

#ifdef __APPLE__
#   ifdef __LP64__
#	undef TCL_WIDE_INT_TYPE
#	define TCL_WIDE_INT_IS_LONG 1
#	define TCL_CFG_DO64BIT 1
#    else /* !__LP64__ */
#	define TCL_WIDE_INT_TYPE long long
#	undef TCL_WIDE_INT_IS_LONG
#	undef TCL_CFG_DO64BIT
#    endif /* __LP64__ */
#    undef HAVE_STRUCT_STAT64
#endif /* __APPLE__ */








/*
 * 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))
 *
 * Note on converting between Tcl_WideInt and strings. This implementation (in
 * tclObj.c) depends on the function
 * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
 */

#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
#   if defined(_WIN32) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO)
#      define TCL_WIDE_INT_TYPE __int64
#      define TCL_LL_MODIFIER	"I64"
#      if defined(_WIN64)
#         define TCL_Z_MODIFIER	"I"
#      endif
#   elif defined(__GNUC__)
#      define TCL_Z_MODIFIER	"z"
#   else /* ! _WIN32 && ! __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 /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */

#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



#   define TCL_LL_MODIFIER	"ll"

#endif /* !TCL_LL_MODIFIER */
#ifndef TCL_Z_MODIFIER
#   if defined(__GNUC__) && !defined(_WIN32)
#	define TCL_Z_MODIFIER	"z"


#   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)))







<



<





>
>
>
>
>
>
>
















<
<
<
<


|
<
<
<
<
<
<
<
<
<




|
|
|
<
|
|









>
>
>
|
>




>
>







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
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
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_PackageInitProc) (Tcl_Interp *interp);
typedef int (Tcl_PackageUnloadProc) (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);






/*
 *----------------------------------------------------------------------------
 * 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.
 */








|
|


















|
>
>
>
>
>







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
805
806
807
808
809
810
811
812

/*
 * 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	24

/*
 * 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







|







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
936
937
938
939
940
941
942
943
#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







|







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
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
			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 Tcl_WideInt (Tcl_DriverWideSeekProc) (void *instanceData,
			Tcl_WideInt 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,
			Tcl_WideInt 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.







|
|









|







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
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

/*
 * 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 void		Tcl_InitSubsystems(void);
EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
EXTERN void		Tcl_FindExecutable(const char *argv0);

EXTERN void		Tcl_SetPanicProc(
			    TCL_NORETURN1 Tcl_PanicProc *panicProc);
EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
			    const char *pkgName,
			    Tcl_PackageInitProc *initProc,
			    Tcl_PackageInitProc *safeInitProc);



EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
#ifdef _WIN32
EXTERN int		TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
EXTERN int		TclZipfs_AppHook(int *argc, char ***argv);
#endif




































/*
 *----------------------------------------------------------------------------
 * Include the public function declarations that are accessible via the stubs
 * table.
 */

#include "tclDecls.h"







|




|

|
>
|

|
|
|
|
>
>
>


|

|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|







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
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 (c) 1983 Regents of the University of California.
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by 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.
 */









|
|
|







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
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__) || defined(__BORLANDC__)
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







|







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
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	(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.
 */







|







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
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 = 1 << (i+3);
    expensive = 0;
    if (numBytes+OVERHEAD > maxSize) {
	expensive = 1;
    } else if (i>0 && numBytes+OVERHEAD < maxSize/2) {
	expensive = 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
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) * (1 << (i + 3));
    }

    fprintf(stderr, "\nused:\t");
    for (i = 0; i < NBUCKETS; i++) {
	fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]);
	totalUsed += numMallocs[i] * (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 (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
	    MAXMALLOC, numMallocs[NBUCKETS]);

    Tcl_MutexUnlock(allocMutexPtr);
}
#endif

#else	/* !USE_TCLALLOC */







|





|




|







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
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 (c) 2010 by Ozgur Dogan Ugurlu.
 * Copyright (c) 2010 by Kevin B. Kenny.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*-
 *- THINGS TO DO:








|
|







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
890
891
892
893
894
895
896
897
	Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL);
    }

    /*
     * Set up the compilation environment, and assemble the code.
     */

    source = TclGetStringFromObj(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);







|







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
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 = TclGetStringFromObj(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, "");







|







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
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 = TclGetStringFromObj(operand1Obj, &operand1Len);
	    litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);

	    /*
	     * Assumes that PUSH is the first slot!
	     */

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);







|







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
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 = TclGetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
	Tcl_DecrRefCount(varNameObj);
	return -1;
    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
    Tcl_DecrRefCount(varNameObj);
    if (localVar == -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
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 (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"








|
|







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
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 (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <[email protected]>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 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"







|
|
|
|
|
|
|







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
3602
3603
3604
3605
3606
3607
3608
3609
	    flags &= ~TCL_TRACE_RENAME;
	}
	if (flags == 0) {
	    return NULL;
	}
    }
    cmdPtr->flags |= CMD_TRACE_ACTIVE;
    cmdPtr->refCount++;

    result = NULL;
    active.nextPtr = iPtr->activeCmdTracePtr;
    active.reverseScan = 0;
    iPtr->activeCmdTracePtr = &active;

    if (flags & TCL_TRACE_DELETE) {







<







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
3660
3661
3662
3663
3664
3665
3666
3667

    /*
     * Restore the variable's flags, remove the record of our active traces,
     * and then return.
     */

    cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
    cmdPtr->refCount--;
    iPtr->activeCmdTracePtr = active.nextPtr;
    Tcl_Release(iPtr);
    return result;
}

/*
 *----------------------------------------------------------------------







<







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
3957
3958
3959
3960
3961
3962
3963
3964

        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

        if (iPtr->asyncCancelMsg != NULL) {
            message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length);
        } else {
            length = 0;
        }

        if (iPtr->flags & TCL_CANCEL_UNWIND) {
            id = "IUNWIND";
            if (length == 0) {







|







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
4056
4057
4058
4059
4060
4061
4062
4063
     * cancellation request. Currently, clientData is ignored. If the
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	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;
    }







|







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
4555
4556
4557
4558
4559
4560
4561
4562
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

	listPtr = Tcl_NewListObj(objc, objv);
	cmdString = TclGetStringFromObj(listPtr, &cmdLen);
	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
	Tcl_DecrRefCount(listPtr);
    }
    iPtr->flags &= ~ERR_ALREADY_LOGGED;
    return result;
}








|







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
4701
4702
4703
4704
4705
4706
4707
4708
    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 = TclGetStringFromObj(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.
     */







|







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
4753
4754
4755
4756
4757
4758
4759
4760
    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 = TclGetStringFromObj(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) {







|







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
5995
5996
5997
5998
5999
6000
6001
6002

	assert(invoker == NULL);

	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);

	Tcl_IncrRefCount(objPtr);

	script = TclGetStringFromObj(objPtr, &numSrcBytes);
	result = Tcl_EvalEx(interp, script, numSrcBytes, flags);

	TclDecrRefCount(objPtr);

	iPtr->scriptCLLocPtr = saveCLLocPtr;
	return result;
    }







|







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
6026
6027
6028
6029
6030
6031
6032
6033
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    size_t numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = TclGetStringFromObj(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.
	 */







|







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
6557
6558
6559
6560
6561
6562
6563
6564
void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    size_t length;
    const char *message = TclGetStringFromObj(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.







|







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
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152









7153
7154
7155
7156
7157
7158
7159
7160
	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 = TclGetStringFromObj(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 (mp_init_i64(&big, l) != MP_OKAY) {
		return TCL_ERROR;
	    }
	    goto tooLarge;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
	return TCL_OK;
    }







|











>
>
>
>
>
>
>
>
>
|







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
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 (c) 1997 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"






|
|







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
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508

509
510
511
512
513
514
515
516
517
    }
    return baPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetByteArrayFromObj --
 *
 *	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.
 *
 *----------------------------------------------------------------------
 */


unsigned char *
Tcl_GetByteArrayFromObj(
    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);








|














>

|







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
534
535
536
537
538
539
540
541
542
543
544


























545
546
547
548
549
550
551
    }

    /* 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. This case will be developed out of existence
	     * in Tcl 9. As interim measure, fail. */

	    *lengthPtr = 0;
	    return NULL;
	} else {
	    *lengthPtr = (int) numBytes;
	}
    }
    return bytes;
}



























/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetByteArrayLength --
 *
 *	This procedure changes the length of the byte array for this object.







|
<
<








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
640
641
642
643
644
645
646
647
    if (TclHasIntRep(objPtr, &properByteArrayType)) {
	return TCL_OK;
    }
    if (TclHasIntRep(objPtr, &tclByteArrayType)) {
	return TCL_OK;
    }

    src = TclGetStringFromObj(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)) {







|







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
1032
1033
1034
1035
1036
1037
1038
1039
	     * of bytes in a single argument.
	     */

	    if (arg >= objc) {
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		(void)TclGetByteArrayFromObj(objv[arg], &count);
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    arg++;
	    if (cmd == 'a' || cmd == 'A') {
		offset += count;
	    } else if (cmd == 'b' || cmd == 'B') {







|







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
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
	}
	switch (cmd) {
	case 'a':
	case 'A': {
	    char pad = (char) (cmd == 'a' ? '\0' : ' ');
	    unsigned char *bytes;

	    bytes = TclGetByteArrayFromObj(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 = TclGetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 7) / 8);







|



















|







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
1278
1279
1280
1281
1282
1283
1284
1285
	    break;
	}
	case 'h':
	case 'H': {
	    unsigned char *last;
	    int c;

	    str = TclGetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 1) / 2);







|







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
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520

1521
1522
1523
1524
1525
1526
1527
1528
    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"value formatString ?varName ...?");
	return TCL_ERROR;
    }
    numberCachePtr = &numberCacheHash;
    Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
    buffer = TclGetByteArrayFromObj(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': {
	    unsigned char *src;

	    if (arg >= objc) {
		DeleteScanNumberCache(numberCachePtr);
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {







|











>
|







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

1543
1544
1545
1546







1547
1548
1549
1550
1551
1552
1553
		}
	    }

	    src = buffer + offset;
	    size = count;

	    /*

	     * Trim trailing nulls and spaces, if necessary.
	     */

	    if (cmd == 'A') {







		while (size > 0) {
		    if (src[size - 1] != '\0' && src[size - 1] != ' ') {
			break;
		    }
		    size--;
		}
	    }







>
|


|
>
>
>
>
>
>
>







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
2562
2563
2564
2565
2566
2567
2568
2569

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    data = TclGetByteArrayFromObj(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;







|







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
2624
2625
2626
2627
2628
2629
2630
2631
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 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
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const char *)TclGetBytesFromObj(NULL,
		    objv[i + 1], &wrapcharlen);
	    if (wrapchar == NULL) {
		purewrap = 0;
		wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen);
	    }
	    break;
	}
    }
    if (wrapcharlen == 0) {
	maxlen = 0;
    }

    TclNewObj(resultObj);
    data = TclGetByteArrayFromObj(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));








|









|







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
2879
2880
2881
2882
2883
2884
2885
2886
		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 *) TclGetStringFromObj(
		    objv[i + 1], &wrapcharlen);
	    {
		const unsigned char *p = wrapchar;
		size_t numBytes = wrapcharlen;

		while (numBytes) {
		    switch (*p) {







|







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
2921
2922
2923
2924
2925
2926
2927
2928
    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    TclNewObj(resultObj);
    offset = 0;
    data = TclGetByteArrayFromObj(objv[objc - 1], &count);
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 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
3021
3022
3023
3024
3025
3026
3027
3028
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;








|







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
3196
3197
3198
3199
3200
3201
3202
3203
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(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;







|







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
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 (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 */








|
|
|







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
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 and Mark Diekhans.
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"








|
|
|







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


1660
1661
1662



1663

1664




1665


1666
1667
1668
1669
1670
1671
1672
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;
    }


    varName = TclGetString(objv[1]);
    varValue = getenv(varName);
    if (varValue == NULL) {



	varValue = "";

    }




    Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ThreadSafeLocalTime --







>
>
>
>
>


>





>
>
|
|

>
>
>
|
>

>
>
>
>
|
>
>







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
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
	Tcl_WrongNumArgs(interp, 1, objv, "?-switch?");
	return TCL_ERROR;
    }

    switch (index) {
    case CLICKS_MILLIS:
	Tcl_GetTime(&now);
	clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
	break;
    case CLICKS_NATIVE:
#ifdef TCL_WIDE_CLICKS
	clicks = TclpGetWideClicks();
#else
	clicks = (Tcl_WideInt) TclpGetClicks();
#endif
	break;
    case CLICKS_MICROS:
	clicks = TclpGetMicroseconds();
	break;
    }








|





|







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
2027
2028



2029
2030














2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
 *	None.
 *
 * Side effects:
 *	Calls tzset.
 *
 *----------------------------------------------------------------------
 */










static void
TzsetIfNecessary(void)
{
    static char* tzWas = (char *)INT2PTR(-1);	/* Previous value of TZ, protected by
				 * clockMutex. */



    const char *tzIsNow;	/* Current value of TZ */















    Tcl_MutexLock(&clockMutex);
    tzIsNow = getenv("TZ");
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
	    || strcmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
	    Tcl_Free(tzWas);
	}
	tzWas = (char *)Tcl_Alloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) Tcl_Free(tzWas);
	tzWas = NULL;
    }
    Tcl_MutexUnlock(&clockMutex);
}

/*
 *----------------------------------------------------------------------








>
>
>
>
>
>
>
>
>



|
|
>
>
>
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>


|
|

|


|
|


|







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
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 (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifdef _WIN32






|
|







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
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 *) TclGetByteArrayFromObj(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.
     */








|







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
499
500
501
502
503
504
505
506
	return TCL_ERROR;
    }

    /*
     * Convert the string to a byte array in 'ds'
     */

    stringPtr = TclGetStringFromObj(data, &length);
    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
    Tcl_SetObjResult(interp,
		     Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
					 Tcl_DStringLength(&ds)));
    Tcl_DStringFree(&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
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 (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 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"








|
|
|
|
|
|







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
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 = TclGetStringFromObj(procPtr->bodyPtr, &numBytes);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







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
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 TclGetLoadedPackagesEx(interp, interpName, packageName);
}

/*
 *----------------------------------------------------------------------
 *
 * InfoNameOfExecutableCmd --
 *







|







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
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) TclGetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	int i;

	resObjPtr = Tcl_NewObj();
	for (i = 0;  i < listLen;  i++) {







|







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
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 = TclGetStringFromObj(patObj, &length);
	    break;
	case INTEGER:
	    result = TclGetWideIntFromObj(interp, patObj, &patWide);
	    if (result != TCL_OK) {
		goto done;
	    }








|







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
3572
3573
3574
3575
3576
3577
3578
3579
	     * 1844789]
	     */

	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
	    break;
	}
    } else {
	patternBytes = TclGetStringFromObj(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.
     */








|







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
3716
3717
3718
3719
3720
3721
3722
3723
	    }

	    switch (mode) {
	    case SORTED:
	    case EXACT:
		switch ((enum datatypes) dataType) {
		case ASCII:
		    bytes = TclGetStringFromObj(itemPtr, &elemLen);
		    if (length == elemLen) {
			/*
			 * This split allows for more optimal compilation of
			 * memcmp/strcasecmp.
			 */

			if (noCase) {







|







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
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 (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2003-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"








|
|
|
|
|







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
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 --
 *







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







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
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 = TclGetUnicodeFromObj(objv[0], &slen);
	wstring = TclGetUnicodeFromObj(objv[1], &wlen);
	wsubspec = TclGetUnicodeFromObj(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.







|
|
|







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
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 = TclGetUnicodeFromObj(objPtr, &wlen);
    if (objv[2] == objv[0]) {
	subPtr = Tcl_DuplicateObj(objv[2]);
    } else {
	subPtr = objv[2];
    }
    if (!command) {
	wsubspec = TclGetUnicodeFromObj(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







|






|







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
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 = TclGetUnicodeFromObj(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







|







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
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 = TclGetStringFromObj(objv[2], &splitCharLen);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
	return TCL_ERROR;
    }

    stringPtr = TclGetStringFromObj(objv[1], &stringLen);
    end = stringPtr + stringLen;
    listPtr = Tcl_NewObj();

    if (stringLen == 0) {
	/*
	 * Do nothing.
	 */







|





|







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
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 = TclGetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }
	} else if ((objPtr->internalRep.wideValue != 0)
		? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) {
	    result = 0;
	}
	break;







|







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
1651
1652
1653
1654
1655
1656
1657
1658
	     */

	    const char *elemStart, *nextElem;
	    int lenRemain;
	    size_t elemSize;
	    const char *p;

	    string1 = TclGetStringFromObj(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;







|







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
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 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;







|







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
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 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;







|







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
1763
1764
1765
1766
1767
1768
1769
1770
	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	result = 0;







|







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
1832
1833
1834
1835
1836
1837
1838
1839
	     */

	    const char *elemStart, *nextElem;
	    size_t lenRemain;
	    size_t elemSize;
	    const char *p;

	    string1 = TclGetStringFromObj(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;







|







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
1887
1888
1889
1890
1891
1892
1893
1894
	break;
    case STR_IS_XDIGIT:
	chcomp = UniCharIsHexDigit;
	break;
    }

    if (chcomp != NULL) {
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;







|







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
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 = TclGetStringFromObj(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));







|







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
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 = TclGetUnicodeFromObj(sourceObj, &length1);
    if (length1 == 0) {
	/*
	 * Empty input string, just stop now.
	 */

	goto done;
    }







|







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
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 = TclGetUnicodeFromObj(mapElemv[0], &length2);
	p = ustring1;
	if ((length2 > length1) || (length2 == 0)) {
	    /*
	     * Match string is either longer than input or empty.
	     */

	    ustring1 = end;
	} else {
	    mapString = TclGetUnicodeFromObj(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) {







|








|







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
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] = TclGetUnicodeFromObj(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) {







|







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
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 = TclGetStringFromObj(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));







|







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
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
StringStartCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    const char *p, *string;
    size_t numChars, length, cur, index;
    Tcl_Obj *obj;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = TclGetStringFromObj(objv[1], &length);
    numChars = Tcl_NumUtfChars(string, length) - 1;
    if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = TclGetString(objv[1]);
    if (index + 1 > numChars + 1) {
	index = numChars;
    }
    cur = 0;
    if (index + 1 > 1) {
	p = Tcl_UtfAtIndex(string, index);

	TclUtfToUCS4(p, &ch);
	for (cur = index; cur != TCL_INDEX_NONE; cur--) {
	    int delta = 0;
	    const char *next;

	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }

	    next = TclUtfPrev(p, string);
	    do {
		next += delta;
		delta = TclUtfToUCS4(next, &ch);
	    } while (next + delta < p);
	    p = next;
	}
	if (cur != index) {
	    cur += 1;
	}
    }







|
|







|
<
|


<
|
|



|

|


|





|


|







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
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
StringEndCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    const char *p, *end, *string;
    size_t length, numChars, cur, index;
    Tcl_Obj *obj;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = TclGetStringFromObj(objv[1], &length);
    numChars = Tcl_NumUtfChars(string, length) - 1;
    if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = TclGetStringFromObj(objv[1], &length);
    if (index == TCL_INDEX_NONE) {
	index = TCL_INDEX_START;
    }
    if (index + 1 <= numChars + 1) {
	p = Tcl_UtfAtIndex(string, index);
	end = string+length;
	for (cur = index; p < end; cur++) {
	    p += TclUtfToUCS4(p, &ch);
	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }
	}
	if (cur == index) {
	    cur++;
	}
    } else {
	cur = numChars + 1;
    }
    TclNewIndexObj(obj, cur);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*







|
|







|
<
|


<



|
|


|








|







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
2661
2662
2663
2664
2665
2666
2667
2668
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string2 = TclGetStringFromObj(objv[i], &length);
	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;
	    }







|







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
2760
2761
2762
2763
2764
2765
2766
2767
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string = TclGetStringFromObj(objv[i], &length);
	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;
	    }







|







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
2861
2862
2863
2864
2865
2866
2867
2868
    size_t length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    (void) TclGetStringFromObj(objv[1], &length);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







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
2934
2935
2936
2937
2938
2939
2940
2941
    char *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(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);







|







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
2969
2970
2971
2972
2973
2974
2975
2976
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(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));







|







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
3019
3020
3021
3022
3023
3024
3025
3026
    char *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(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);







|







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
3054
3055
3056
3057
3058
3059
3060
3061
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(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));







|







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
3104
3105
3106
3107
3108
3109
3110
3111
    char *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(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);







|







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
3139
3140
3141
3142
3143
3144
3145
3146
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(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));







|







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
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
    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 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    triml = TclTrim(string1, length1, string2, length2, &trimr);

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
    return TCL_OK;
}







|







|







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
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    size_t length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    trim = TclTrimLeft(string1, length1, string2, length2);

    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim));
    return TCL_OK;
}








|







|







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
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    size_t length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    trim = TclTrimRight(string1, length1, string2, length2);

    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
    return TCL_OK;
}








|







|







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
3700
3701
3702
3703
3704
3705
3706
3707
    }

    for (i = 0; i < objc; i += 2) {
	/*
	 * See if the pattern matches the string.
	 */

	pattern = TclGetStringFromObj(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







|







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
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 (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2013 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"






|
|
|
|







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
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 = TclGetStringFromObj(objPtr, &slen);
	PushLiteral(envPtr, bytes, slen);
	Tcl_DecrRefCount(objPtr);
	return TCL_OK;
    }

    /*
     * General case: runtime concat.







|







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
1336
1337
1338
1339
1340
1341
1342
1343
	Tcl_DecrRefCount(valueObj);
    }

    /*
     * We did! Excellent. The "verifyDict" is to do type forcing.
     */

    bytes = TclGetStringFromObj(dictObj, &len);
    PushLiteral(envPtr, bytes, len);
    TclEmitOpcode(		INST_DUP,			envPtr);
    TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
    Tcl_DecrRefCount(dictObj);
    return TCL_OK;

    /*







|







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
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 = TclGetStringFromObj(varNameObj, &length);
	    varIndex = LocalScalar(bytes, length, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}







|







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
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 = TclGetStringFromObj(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







|







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
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 = TclGetStringFromObj(tmpObj, &len);

		/*
		 * If there is a non-empty literal from the format string,
		 * push it and reset.
		 */

		if (len > 0) {







|







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
3318
3319
3320
3321
3322
3323
3324
3325
    }

    /*
     * Handle the case of a trailing literal.
     */

    Tcl_AppendToObj(tmpObj, start, bytes - start);
    bytes = TclGetStringFromObj(tmpObj, &len);
    if (len > 0) {
	PushLiteral(envPtr, bytes, len);
	i++;
    }
    Tcl_DecrRefCount(tmpObj);
    Tcl_DecrRefCount(formatObj);








|







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
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 (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2013 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"







|
|
|
|







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
2307
2308
2309
2310
2311
2312
2313
2314
    }

    /*
     * Next, higher-level checks. Is the RE a very simple glob? Is the
     * replacement "simple"?
     */

    bytes = TclGetStringFromObj(patternObj, &len);
    if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
	    != TCL_OK || exact || quantified) {
	goto done;
    }
    bytes = Tcl_DStringValue(&pattern);
    if (*bytes++ != '*') {
	goto done;







|







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
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 = TclGetStringFromObj(replacementObj, &len);
    PushLiteral(envPtr,	bytes, len);
    CompileWord(envPtr,	stringTokenPtr, interp, parsePtr->numWords - 2);
    TclEmitOpcode(	INST_STR_MAP,	envPtr);

  done:
    Tcl_DStringFree(&pattern);
    if (patternObj) {







|







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
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 = TclGetStringFromObj(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);
}







|







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
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 = TclGetStringFromObj(tailPtr, &len);

    if (len) {
	if (*(tailName + len - 1) == ')') {
	    /*
	     * Possible array: bail out
	     */








|







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
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 (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2010 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"








|
|
|
|







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
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 = TclGetStringFromObj(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 = TclGetStringFromObj(folded, &len);

	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(folded);
	folded = NULL;
	numArgs ++;
    }
    if (numArgs > 1) {







|

















|







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
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 = TclGetStringFromObj(objv[0], &slen);
    if (slen == 0) {
	CompileWord(envPtr, stringTokenPtr, interp, 2);
    } else {
	PushLiteral(envPtr, bytes, slen);
	bytes = TclGetStringFromObj(objv[1], &slen);
	PushLiteral(envPtr, bytes, slen);
	CompileWord(envPtr, stringTokenPtr, interp, 2);
	OP(STR_MAP);
    }
    Tcl_DecrRefCount(mapObj);
    return TCL_OK;
}







|




|







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
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 = TclGetStringFromObj(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 = TclGetStringFromObj(objv[1], &len);

		optionVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (optionVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
	    } else {







|











|







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
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 = TclGetStringFromObj(matchClauses[i], &slen);
	    PushLiteral(envPtr, p, slen);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1;
	}
	OP(				POP);







|







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
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 = TclGetStringFromObj(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
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
3673
3674
3675
3676
3677
3678
3679
3680
	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    size_t len;

	    bytes = TclGetStringFromObj(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++;







|







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
465
466
467
468
469
470
471
472
	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		/* " */,	INVALID		/* # */,
	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 */







|







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
677

678
679
680
681
682
683
684
685
686
	 */

	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;







|
>
|
|







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
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910













1911
1912
1913
1914
1915
1916
1917
    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;
    Tcl_UniChar ch = 0;
    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 '*':
	if ((numBytes > 1) && (start[1] == '*')) {
	    *lexemePtr = EXPON;
	    return 2;
	}
	*lexemePtr = MULT;
	return 1;







|













>
>
>
>
>
>
>
>
>
>
>
>
>







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
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
     * 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 = TclUtfToUniChar(start, &ch);
	} else {
	    char utfBytes[4];

	    memcpy(utfBytes, start, numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUniChar(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }
    end = start;
    while (numBytes && TclIsBareword(*end)) {







|

|



|







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
2309
2310
2311
2312
2313
2314
2315
2316
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		size_t length;

		Tcl_DStringInit(&cmdName);
		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
		p = TclGetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
		Tcl_DStringFree(&cmdName);








|







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
2465
2466
2467
2468
2469
2470
2471
2472
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		size_t length;
		const char *bytes = TclGetStringFromObj(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:
		     *







|







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
2525
2526
2527
2528
2529
2530
2531
2532
		     * already, then use it to share via the literal table.
		     */

		    if (TclHasStringRep(objPtr)) {
			Tcl_Obj *tableValue;
			size_t numBytes;
			const char *bytes
				= TclGetStringFromObj(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.







|







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
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 (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"







|
|







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
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 = TclGetStringFromObj(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.
     */








|







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
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 = TclGetStringFromObj(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);







|







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
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 = TclGetStringFromObj(cmdObj, &length);
    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);

    if (cmdPtr && TclRoutineHasName(cmdPtr)) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}







|







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
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 = TclGetStringFromObj(objPtr, &numBytes);
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

	    Tcl_IncrRefCount(copyPtr);
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
	}







|







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
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 = TclGetStringFromObj(*varNamePtr, &len);
		if ((len == nameBytes) && !strncmp(name, localName, len)) {
		    return i;
		}
	    }
	}
	return -1;
    }







|







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
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 (c) 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"







|







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
181
182
183
184
185
186
187
188

/*
 *----------------------------------------------------------------------
 *
 * QueryConfigObjCmd --
 *
 *	Implementation of "::<package>::pkgconfig", the command to query
 *	configuration information embedded into a binary library.
 *
 * Results:
 *	A standard tcl result.
 *
 * Side effects:
 *	See the manual for what this command does.
 *







|







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
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 *) TclGetByteArrayFromObj(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:







|







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
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 and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"







|







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
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
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);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, void *clientData);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 9 */
EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, void *clientData);
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
EXTERN void		Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 10 */
EXTERN void		Tcl_DeleteFileHandler(int fd);
#endif /* MACOSX */
/* 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 */







<



<
<
<
<
<
<
<


<
<
<
<
<







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
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
/* 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 *	Tcl_GetByteArrayFromObj(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 *		Tcl_GetStringFromObj(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,







|




















|







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
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
				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);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, void **filePtr);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 167 */
EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, void **filePtr);
#endif /* MACOSX */
/* 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 */







<




<
<
<
<
<
<
<







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
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
/* 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		Tcl_UtfCharComplete(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 *	Tcl_UtfNext(const char *src);
/* 331 */
EXTERN const char *	Tcl_UtfPrev(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);







|








|

|







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
1150
1151
1152
1153
1154
1155
1156
1157
1158
				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 *	Tcl_GetUnicodeFromObj(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,







|
<







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
1175
1176
1177
1178
1179
1180
1181
1182
1183
/* 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_PackageInitProc **proc1Ptr,
				Tcl_PackageInitProc **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 */







|
|







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
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
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 Tcl_WideInt	Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
				int mode);
/* 492 */
EXTERN Tcl_WideInt	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 */







|


|







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
1501
1502
1503
1504
1505
1506
1507
1508
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,
				Tcl_WideInt length);
/* 561 */
EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
				const Tcl_ChannelType *chanTypePtr);
/* 562 */
EXTERN void		Tcl_SetChannelErrorInterp(Tcl_Interp *interp,
				Tcl_Obj *msg);
/* 563 */







|







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
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
/* 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 Tcl_WideInt	Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
/* 597 */
EXTERN Tcl_WideInt	Tcl_GetModificationTimeFromStat(
				const Tcl_StatBuf *statPtr);
/* 598 */
EXTERN Tcl_WideInt	Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
/* 599 */
EXTERN Tcl_WideUInt	Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
/* 600 */
EXTERN Tcl_WideUInt	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,







|

|


|

|

|







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
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
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 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved9)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved10)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* MACOSX */
    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 */







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




















<

<
<
<
<
<
<
<
<

<
<
<
<
<
<
<







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
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
    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 * (*tcl_GetByteArrayFromObj) (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 * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
    void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
    int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
    int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
    int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
    int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */







|







|







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
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
    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 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */
#endif /* MACOSX */
    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);







<

<
<
<
<
<
<
<







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
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
    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 (*tcl_UtfCharComplete) (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 * (*tcl_UtfNext) (const char *src); /* 330 */
    const char * (*tcl_UtfPrev) (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 */







|



|
|







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
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
    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 * (*tcl_GetUnicodeFromObj) (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_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **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 */







|









|







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
2280
2281
2282
2283
2284
2285
2286
2287
2288
    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 */
    Tcl_WideInt (*tcl_Seek) (Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 491 */
    Tcl_WideInt (*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 */







|
|







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
2349
2350
2351
2352
2353
2354
2355
2356
    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, Tcl_WideInt 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 */







|







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
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
    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 */
    Tcl_WideInt (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */
    Tcl_WideInt (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */
    Tcl_WideInt (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */
    Tcl_WideUInt (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */
    Tcl_WideUInt (*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 */







|
|
|
|
|







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
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
	(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 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_CreateFileHandler \
	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_CreateFileHandler \
	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_DeleteFileHandler \
	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_DeleteFileHandler \
	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif /* MACOSX */
#define Tcl_SetTimer \
	(tclStubsPtr->tcl_SetTimer) /* 11 */
#define Tcl_Sleep \
	(tclStubsPtr->tcl_Sleep) /* 12 */
#define Tcl_WaitForEvent \
	(tclStubsPtr->tcl_WaitForEvent) /* 13 */
#define Tcl_AppendAllObjTypes \







<


<
<
<
<
<
<


<
<
<
<
<







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
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
	(tclStubsPtr->tcl_DuplicateObj) /* 29 */
#define TclFreeObj \
	(tclStubsPtr->tclFreeObj) /* 30 */
#define Tcl_GetBoolean \
	(tclStubsPtr->tcl_GetBoolean) /* 31 */
#define Tcl_GetBooleanFromObj \
	(tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
#define Tcl_GetByteArrayFromObj \
	(tclStubsPtr->tcl_GetByteArrayFromObj) /* 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 Tcl_GetStringFromObj \
	(tclStubsPtr->tcl_GetStringFromObj) /* 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 \







|
|













|
|







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
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
	(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 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_GetOpenFile \
	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_GetOpenFile \
	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif /* MACOSX */
#define Tcl_GetPathType \
	(tclStubsPtr->tcl_GetPathType) /* 168 */
#define Tcl_Gets \
	(tclStubsPtr->tcl_Gets) /* 169 */
#define Tcl_GetsObj \
	(tclStubsPtr->tcl_GetsObj) /* 170 */
#define Tcl_GetServiceMode \







<


<
<
<
<
<







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
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
	(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 Tcl_UtfCharComplete \
	(tclStubsPtr->tcl_UtfCharComplete) /* 326 */
#define Tcl_UtfBackslash \
	(tclStubsPtr->tcl_UtfBackslash) /* 327 */
#define Tcl_UtfFindFirst \
	(tclStubsPtr->tcl_UtfFindFirst) /* 328 */
#define Tcl_UtfFindLast \
	(tclStubsPtr->tcl_UtfFindLast) /* 329 */
#define Tcl_UtfNext \
	(tclStubsPtr->tcl_UtfNext) /* 330 */
#define Tcl_UtfPrev \
	(tclStubsPtr->tcl_UtfPrev) /* 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 \







|
|






|
|
|
|







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
3277
3278
3279
3280
3281
3282
3283
3284
3285
	(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 Tcl_GetUnicodeFromObj \
	(tclStubsPtr->tcl_GetUnicodeFromObj) /* 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 \







|
|







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
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
	(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. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
#   undef Tcl_Init
#   undef Tcl_ObjSetVar2
#   define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
#   define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
#   define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
	    (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
#endif

#if defined(_WIN32) && defined(UNICODE)
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#   define Tcl_MainEx Tcl_MainExW
    EXTERN TCL_NORETURN void Tcl_MainExW(int argc, wchar_t **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif

#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)







>
>
>
>
>
>
>
>
>
>
>
>
>
>





<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
3848
3849
3850
3851
3852
3853
3854
3855
#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_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)
#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







<







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
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
#	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)

#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX <= 3)
#   undef Tcl_UtfCharComplete
#   define Tcl_UtfCharComplete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
	    ? ((length) >= TCL_UTF_MAX) : tclStubsPtr->tcl_UtfCharComplete((src), (length)))
#endif
#ifndef TCL_NO_DEPRECATED
#   define Tcl_CreateSlave Tcl_CreateChild
#   define Tcl_GetSlave Tcl_GetChild
#   define Tcl_GetMaster Tcl_GetParent
#endif

#endif /* _TCLDECLS */







|
|
|
<
|







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
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 (c) 2002-2010 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"






|







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
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 = TclGetStringFromObj(keyPtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
    TclOOM(dst, bytesNeeded);
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);







|



|













|





|







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
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 = TclGetStringFromObj(objPtr, &length);
	const char *limit = (nextElem + length);

	while (nextElem < limit) {
	    Tcl_Obj *keyPtr, *valuePtr;
	    const char *elemStart;
	    size_t elemSize;
	    int literal;







|







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
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 (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 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"






|
|
|







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
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 = TclGetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --







|







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
656
657
658
659
660
661
662
663
	}
    }
    if (suffixObj) {
	const char *bytes;
	size_t length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = TclGetStringFromObj(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);
	}
    }







|







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
6
7
8
9
10
11
12
13
/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 *
 * Copyright (c) 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"






|







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
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
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 int              	UtfToUtfProc(ClientData clientData,
	                            const char *src, int srcLen, int flags,
       		                    Tcl_EncodingState *statePtr, char *dst,
				    int dstLen, int *srcReadPtr,
				    int *dstWrotePtr, int *dstCharsPtr,
				    int pureNullMode);
static Tcl_EncodingConvertProc	UtfIntToUtfExtProc;
static Tcl_EncodingConvertProc	UtfExtToUtfIntProc;
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].







<
<
<
<
<
<
|
<







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
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
 *
 * 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;
    }

    isLe.s = 1;
    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	= UtfExtToUtfIntProc;
    type.fromUtfProc	= UtfIntToUtfExtProc;
    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(1);
    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(1);
    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);







>
>
>
>
>
>
















|



















|
|










|













|







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
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
    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);
	}

	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;







>
>
>






>




<

<







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
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
    } 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 (\xC080). To get
	 * the actual \0 at the end of the destination buffer, we need to
	 * append it manually.  First make room for it...
	 */

	dstLen--;
    }



    do {
	int savedFlags = flags;
	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);
	flags = savedFlags;
	*statePtr = savedState;
    } while (1);
    if (!noTerminate) {
	/* ...and then append it */

	dst[*dstWrotePtr] = '\0';
    }







|






>
>
>

<









<







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
1272
1273
1274
1275
1276
1277
1278
1279
1280
	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);







|
|







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
1374
1375
1376
1377
1378
1379
1380
1381
1382
    }
    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;
}







|
|







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
1402
1403
1404
1405
1406
1407
1408
1409

1410
1411
1412
1413
1414
1415
1416
 * Side effects:
 *	The absolute pathname for the application is computed and stored to be
 *	returned later by [info nameofexecutable].
 *
 *---------------------------------------------------------------------------
 */
#undef Tcl_FindExecutable
void
Tcl_FindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    Tcl_InitSubsystems();
    TclpSetInitialEncodings();
    TclpFindExecutable(argv0);

}

/*
 *---------------------------------------------------------------------------
 *
 * OpenEncodingFileChannel --
 *







|




|


>







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
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
    memcpy(dst, src, srcLen);
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * UtfIntToUtfExtProc --
 *
 *	Convert from UTF-8 to UTF-8. While converting null-bytes from the
 *	Tcl's internal representation (0xC0, 0x80) to the official
 *	representation (0x00). See UtfToUtfProc for details.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfIntToUtfExtProc(
    ClientData clientData,
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    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. */
{
    return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
	    srcReadPtr, dstWrotePtr, dstCharsPtr, 1);
}

/*
 *-------------------------------------------------------------------------
 *
 * UtfExtToUtfIntProc --
 *
 *	Convert from UTF-8 to UTF-8 while converting null-bytes from the
 *	official representation (0x00) to Tcl's internal representation (0xC0,
 *	0x80). See UtfToUtfProc for details.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfExtToUtfIntProc(
    ClientData clientData,
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    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. */
{
    return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
	    srcReadPtr, dstWrotePtr, dstCharsPtr, 0);
}

/*
 *-------------------------------------------------------------------------
 *
 * 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(
    TCL_UNUSED(ClientData),
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    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. */
    int pureNullMode)		/* Convert embedded nulls from internal
				 * representation to real null-bytes or vice
				 * versa. Also combine or separate surrogate pairs */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    int result, numChars, charLimit = INT_MAX;
    int *chPtr = (int *) statePtr;

    if (flags & TCL_ENCODING_START) {
    	*statePtr = 0;
    }
    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;

    dstEnd = dst + dstLen - TCL_UTF_MAX;

    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	if ((src > srcClose) && (!TclUCS4Complete(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 && pureNullMode == 0)) {
	    /*
	     * Copy 7bit characters, but skip null-bytes when we are in input
	     * mode, so that they get converted to 0xC080.
	     */

	    *dst++ = *src++;
	} else if (pureNullMode == 1 && UCHAR(*src) == 0xC0 &&
		(src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
	    /*
	     * Convert 0xC080 to real nulls when we are in output mode.
	     */

	    *dst++ = 0;
	    src += 2;
	} else if (!TclUCS4Complete(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.

	     */






	    *chPtr = UCHAR(*src);
	    src += 1;




	    dst += Tcl_UniCharToUtf(*chPtr, dst);
	} else {

	    src += TclUtfToUCS4(src, chPtr);






	    if ((*chPtr | 0x7FF) == 0xDFFF) {

		/* A surrogate character is detected, handle especially */


		int low = *chPtr;
		size_t len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;

		if (((low & ~0x3FF) != 0xDC00) || (*chPtr & 0x400)) {
			*dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF);
			*dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF);
			*dst++ = (char) ((*chPtr | 0x80) & 0xBF);
			continue;
		}
		src += len;
		dst += Tcl_UniCharToUtf(*chPtr, dst);
		*chPtr = low;
	    }
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
	}
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    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
2346
2347
2348
2349
2350
2351
2352
2353
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
Utf16ToUtfProc(
    ClientData clientData,	/* != NULL means LE, == NUL means BE */
    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







|







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

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
				 * 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;


    /* 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 - (clientData?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 (clientData) {
	    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);
    }







>





>
|
>
>




>
>
|
>
>
|
>
















|




>




>







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
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
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfToUtf16Proc(
    ClientData clientData,	/* != NULL means LE, == NUL means BE */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    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;
    Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;

    if (flags & TCL_ENCODING_START) {
    	*statePtr = 0;
    }
    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);


    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 += TclUtfToUniChar(src, chPtr);

	if (clientData) {
#if TCL_UTF_MAX > 3
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (*chPtr >> 8);
	    } else {
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
	    }
#else
	    *dst++ = (*chPtr & 0xFF);
	    *dst++ = (*chPtr >> 8);
#endif
	} else {
#if TCL_UTF_MAX > 3
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr >> 8);
		*dst++ = (*chPtr & 0xFF);
	    } else {
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);


	    }
#else
	    *dst++ = (*chPtr >> 8);
	    *dst++ = (*chPtr & 0xFF);
#endif
	}
    }
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}







|



|
<
<
<
<


















<
|
<
<
|









>
















|
|
<
<
|
|
|

|
|
|
|

<
<
<
<

<
|
|
|

<
<
|
|
>
>

<
<
<
<







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
2556
2557
2558
2559
2560
2561
2562
2563
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfToUcs2Proc(
    ClientData clientData,	/* != NULL means LE, == NUL means BE */
    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







|







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
2627
2628
2629
2630
2631
2632
2633
2634
#endif

	/*
	 * Need to handle this in a way that won't cause misalignment by
	 * casting dst to a Tcl_UniChar. [Bug 1122671]
	 */

	if (clientData) {
	    *dst++ = (ch & 0xFF);
	    *dst++ = (ch >> 8);
	} else {
	    *dst++ = (ch >> 8);
	    *dst++ = (ch & 0xFF);
	}
    }







|







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
3035


3036
3037
3038
3039
3040
3041
3042
#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) '?';
	}







|
>
>







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
3080
3081
3082
3083
3084
3085
3086
3087
 */

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;







|







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
3138
3139
3140
3141
3142
3143
3144
3145
    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) {







|







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
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714

    Tcl_DecrRefCount(libPathObj);
    Tcl_DecrRefCount(encodingObj);
    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetStringFromObj(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:
 */







|












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
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 (c) 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"






|







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
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 = TclGetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {







|







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
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 = TclGetStringFromObj(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) {







|







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
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 = TclGetStringFromObj(words[i-1], &length);
	    PushLiteral(envPtr, bytes, length);
	    continue;
	}

	SetLineInformation(i);
	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterLiteral(envPtr,







|







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
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 = TclGetStringFromObj(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);







|







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
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 (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 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"









|
|







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
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 (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004 by 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"








|
|
|







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

1016








1017
1018
1019
1020
1021
1022
1023
 *
 * Side effects:
 *	Varied, see the respective initialization routines.
 *
 *-------------------------------------------------------------------------
 */


void








Tcl_InitSubsystems(void)
{
    if (inExit != 0) {
	Tcl_Panic("Tcl_InitSubsystems called while exiting");
    }

    if (subsystemsInitialized == 0) {







>
|
>
>
>
>
>
>
>
>







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
1505
1506
1507
1508
1509
1510
1511
1512
    } 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_WINDOW_EVENTS|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;







|







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
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 (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2002-2010 by Miguel Sofer.
 * Copyright (c) 2005-2007 by Donal K. Fellows.
 * Copyright (c) 2007 Daniel A. Steffen <[email protected]>
 * Copyright (c) 2006-2008 by 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"





|
|
|
|
|
|
|







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
1440
1441
1442
1443
1444
1445
1446
1447

    if (codePtr == NULL) {
	/*
	 * TIP #280: No invoker (yet) - Expression compilation.
	 */

	size_t length;
	const char *string = TclGetStringFromObj(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.







|







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
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 = TclGetStringFromObj(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 = TclGetStringFromObj(o, &s2len);
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}







|

















|







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
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 = TclGetStringFromObj(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 = TclGetStringFromObj(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 = TclGetStringFromObj(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));







|
















|
















|







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
5115
5116
5117
5118
5119
5120
5121
5122
	}
	CACHE_STACK_INFO();

	if (index >= slength) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(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);








|







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
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 = TclGetUnicodeFromObj(valuePtr, &slength);
	if (slength == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	}
	ustring2 = TclGetUnicodeFromObj(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 = TclGetUnicodeFromObj(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)







|




|











|







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
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 => %d\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 => %d\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 = TclGetUnicodeFromObj(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)) {







|






|








|







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
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 = TclGetUnicodeFromObj(valuePtr, &slength);
	    ustring2 = TclGetUnicodeFromObj(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 = TclGetByteArrayFromObj(valuePtr, &wlen1);
	    bytes2 = TclGetByteArrayFromObj(value2Ptr, &wlen2);
	    match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0);
	} else {
	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
		    TclGetString(value2Ptr), nocase);
	}

	/*







|
|






|
|







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
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 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	trim1 = TclTrimLeft(string1, slength, string2, length2);
	trim2 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM_RIGHT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	trim2 = TclTrimRight(string1, slength, string2, length2);
	trim1 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	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]
	 */








|
|






|
|






|
|







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
9320
9321
9322
9323
9324
9325
9326
9327
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
EvalStatsCmd(
    ClientData unused,		/* 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;







|







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
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) TclGetStringFromObj(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 {







|







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
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
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
	if (statsPtr->srcCount[i] > 0) {
	    minSizeDecade = i;
	    break;
	}
    }
    for (i = 31;  i >= 0;  i--) {
	if (statsPtr->srcCount[i] > 0) {
	    maxSizeDecade = i;
	    break;
	}
    }

    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 >= 0;  i--) {
	if (statsPtr->byteCodeCount[i] > 0) {
	    maxSizeDecade = i;
	    break;
	}
    }

    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 >= 0;  i--) {
	if (statsPtr->lifetimeCount[i] > 0) {
	    maxSizeDecade = i;
	    break;
	}
    }

    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));
    }







|

|
|


>

















|

|
|


>

















|

|
|


>







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
9700
9701
9702
9703
9704
9705
9706
9707
#endif
    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");

    if (objc == 1) {
	Tcl_SetObjResult(interp, objPtr);
    } else {
	Tcl_Channel outChan;
	char *str = TclGetStringFromObj(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 {







|







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
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 (c) 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"






|







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
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 = TclGetStringFromObj(templateObj, &length);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {
	    goto makeTemporary;







|







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
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 = TclGetStringFromObj(templateObj, &length);
	const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {







|







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
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 (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclRegexp.h"






|
|







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
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'.
		 */







|







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
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')







|







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
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)TclGetStringFromObj(eltPtr, &len);
	size += len + 1;
    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */

    *argvPtr = (const char **)Tcl_Alloc(
	    ((((*argcPtr) + 1) * sizeof(char *)) + size));

    /*
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	str = TclGetStringFromObj(eltPtr, &len);
	memcpy(p, str, len + 1);
	p += len+1;
    }

    /*
     * Now set up the argv pointers.
     */







|



















|







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
864
865
866
867
868
869
870
871
{
    int needsSep;
    size_t length;
    char *dest;
    const char *p;
    const char *start;

    start = TclGetStringFromObj(prefix, &length);

    /*
     * Remove the ./ from tilde prefixed elements, and drive-letter prefixed
     * elements on Windows, unless it is the first component.
     */

    p = joining;







|







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
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)TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */








|







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
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)TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */








|







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
1012
1013
1014
1015
1016
1017
1018
1019
    Tcl_IncrRefCount(resultObj);
    Tcl_DecrRefCount(listObj);

    /*
     * Store the result.
     */

    resultStr = TclGetStringFromObj(resultObj, &len);
    Tcl_DStringAppend(resultPtr, resultStr, len);
    Tcl_DecrRefCount(resultObj);

    /*
     * Return a pointer to 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
1371
1372
1373
1374
1375
1376
1377
1378
	separators = "/\\:";
	break;
    }

    if (dir == PATH_GENERAL) {
	size_t pathlength;
	const char *last;
	const char *first = TclGetStringFromObj(pathOrDir,&pathlength);

	/*
	 * Find the last path separator in the path
	 */

	last = first + pathlength;
	for (; last != first; 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
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 = TclGetStringFromObj(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':







|







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
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 = TclGetStringFromObj(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 = TclGetStringFromObj(objv[i], &len);
	    Tcl_Obj *elem;

	    if (len == prefixLen) {
		if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
		    TclNewLiteralStringObj(elem, ".");
		} else {







|

















|







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
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 = TclGetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
			repair++;
		    }
		    repair = -1;
		}







|







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
2413
2414
2415
2416
2417
2418
2419
2420
	 * approach).
	 */

	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) TclGetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {







|







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
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 = TclGetStringFromObj(joinedPtr,&len);

		if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));







|







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
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 = TclGetStringFromObj(joinedPtr,&len);

	    if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	}







|







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
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;
}

Tcl_WideInt
Tcl_GetAccessTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_atime;
}

Tcl_WideInt
Tcl_GetModificationTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_mtime;
}

Tcl_WideInt
Tcl_GetChangeTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_ctime;
}

Tcl_WideUInt
Tcl_GetSizeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideUInt) statPtr->st_size;
}

Tcl_WideUInt
Tcl_GetBlocksFromStat(
    const Tcl_StatBuf *statPtr)
{
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    return (Tcl_WideUInt) statPtr->st_blocks;
#else
    unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);

    return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
#endif
}

#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
unsigned
Tcl_GetBlockSizeFromStat(
    const Tcl_StatBuf *statPtr)







|



|


|



|


|



|


|



|


|




|



|







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
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 (c) 1990-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"








|
|







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
10
11
12
13
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 and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

%parse-param {DateInfo* info}
%lex-param {DateInfo* info}
%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 and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"









|



















|







1
2
3
4
5
6
7
8
9
10
11
12
13
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
7
8
9
10
11
12
13
14
15
/*
 * tclHash.c --
 *
 *	Implementation of in-memory hash tables for Tcl and Tcl-based
 *	applications.
 *
 * Copyright (c) 1991-1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|
|







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
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 (c) 1990-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"









|
|







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
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 (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 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"






|
|







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
3364

3365
3366
3367
3368
3369
3370
3371
 *----------------------------------------------------------------------
 */

int
TclClose(
    Tcl_Interp *interp,		/* Interpreter for errors. */
    Tcl_Channel chan)		/* The channel being closed. Must not be
				 * referenced in any interpreter. */

{
    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;







|
>







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
3626
3627
3628
3629
3630
3631
3632
3633
    }

    /*
     * A user may try to call half-close from within a channel close handler.
     * That won't do.
     */

    if (statePtr->flags & CHANNEL_INCLOSE) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	}
	return TCL_ERROR;
    }







|







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
4143
4144
4145
4146
4147
4148
4149
4150
     */

    if ((len == 1) && (UCHAR(*src) < 0xC0)) {
	return WriteBytes(chanPtr, src, len);
    }

    objPtr = Tcl_NewStringObj(src, len);
    src = (char *) TclGetByteArrayFromObj(objPtr, &len);
    result = WriteBytes(chanPtr, src, len);
    TclDecrRefCount(objPtr);
    return result;
}

/*
 *---------------------------------------------------------------------------







|







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
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
    }
    if (statePtr->encoding == NULL) {
	src = (char *) TclGetByteArrayFromObj(objPtr, &srcLen);
	return WriteBytes(chanPtr, src, srcLen);
    } else {
	src = TclGetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}

static void
WillWrite(
    Channel *chanPtr)







|


|







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
4576
4577
4578
4579
4580
4581
4582
4583
    encoding = statePtr->encoding;

    /*
     * Preserved so we can restore the channel's state in case we don't find a
     * newline in the available input.
     */

    (void)TclGetStringFromObj(objPtr, &oldLength);
    oldFlags = statePtr->inputEncodingFlags;
    oldState = statePtr->inputEncodingState;
    oldRemoved = BUFFER_PADDING;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }








|







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
4959
4960
4961
4962
4963
4964
4965
4966
    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 = TclGetByteArrayFromObj(objPtr, &byteLen);
    oldFlags = statePtr->inputEncodingFlags;
    oldRemoved = BUFFER_PADDING;
    oldLength = byteLen;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }








|







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
6111
6112
6113
6114
6115
6116
6117
6118
     * 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) TclGetStringFromObj(objPtr, &numBytes);
    Tcl_AppendToObj(objPtr, NULL, dstLimit);
    if (toRead == srcLen) {
	size_t size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = size - numBytes;
    } else {







|







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
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
 *
 * Side effects:
 *	May flush output on the channel. May discard queued input.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
Tcl_Seek(
    Tcl_Channel chan,		/* The channel on which to seek. */
    Tcl_WideInt 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. */
    Tcl_WideInt 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;
    }







|


|









|







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
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
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. */
    Tcl_WideInt 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







|










|







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
7216
7217
7218
7219
7220
7221
7222
7223
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_TruncateChannel(
    Tcl_Channel chan,		/* Channel to truncate. */
    Tcl_WideInt length)		/* Length to truncate it to. */
{
    Channel *chanPtr = (Channel *) chan;
    Tcl_DriverTruncateProc *truncateProc =
	    Tcl_ChannelTruncateProc(chanPtr->typePtr);
    int result;

    if (truncateProc == NULL) {







|







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
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
 */

static void
ChannelTimerProc(
    ClientData clientData)
{
    Channel *chanPtr = (Channel *)clientData;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */




    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);
    }



    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);

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --
 *







|
|
>

>
>















>
>
|
|
|
|
|
|
|
|

|
|
|
|
|
|
>
>

>







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
8661
8662
8663
8664
8665
8666
8667
8668
	chPtr->chanPtr = chanPtr;
	chPtr->nextPtr = statePtr->chPtr;
	statePtr->chPtr = chPtr;
    }

    /*
     * The remainder of the initialization below is done regardless of whether
     * or not 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.







|







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
9104
9105
9106
9107
9108
9109
9110
9111
 */

int
TclCopyChannel(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Channel inChan,		/* Channel to read from. */
    Tcl_Channel outChan,	/* Channel to write to. */
    Tcl_WideInt 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;







|







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
9615
9616
9617
9618
9619
9620
9621
9622
	 * Now write the buffer out.
	 */

	if (inBinary || sameEncoding) {
	    buffer = csPtr->buffer;
	    sizeb = size;
	} else {
	    buffer = TclGetStringFromObj(bufObj, &sizeb);
	}

	if (outBinary || sameEncoding) {
	    sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);
	} else {
	    sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
	}







|







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
10819
10820
10821
10822
10823
10824
10825
10826
10827






10828
10829
10830
10831
10832
10833
10834

void
Tcl_SetChannelErrorInterp(
    Tcl_Interp *interp,		/* Interp to store the data into. */
    Tcl_Obj *msg)		/* Error message to store. */
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->chanMsg != NULL) {
	TclDecrRefCount(iPtr->chanMsg);
	iPtr->chanMsg = NULL;
    }

    if (msg != NULL) {
	iPtr->chanMsg = FixLevelCode(msg);
	Tcl_IncrRefCount(iPtr->chanMsg);






    }
    return;
}

/*
 *----------------------------------------------------------------------
 *







<
<
<
|
<




>
>
>
>
>
>







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
10855
10856
10857
10858
10859
10860
10861
10862
10863






10864
10865
10866
10867
10868
10869
10870

void
Tcl_SetChannelError(
    Tcl_Channel chan,		/* Channel to store the data into. */
    Tcl_Obj *msg)		/* Error message to store. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;

    if (statePtr->chanMsg != NULL) {
	TclDecrRefCount(statePtr->chanMsg);
	statePtr->chanMsg = NULL;
    }

    if (msg != NULL) {
	statePtr->chanMsg = FixLevelCode(msg);
	Tcl_IncrRefCount(statePtr->chanMsg);






    }
    return;
}

/*
 *----------------------------------------------------------------------
 *







<
<
<
|
<




>
>
>
>
>
>







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
6
7
8
9
10
11
12
13
/*
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * 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"






|







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
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 = TclGetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    TclChannelRelease(chan);
    Tcl_DecrRefCount(resultPtr);







|







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
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 = TclGetStringFromObj(resultPtr, &len);
	if ((len > 0) && (string[len - 1] == '\n')) {
	    Tcl_SetObjLength(resultPtr, len - 1);
	}
	return TCL_ERROR;
    }

    return TCL_OK;







|







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
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 = TclGetStringFromObj(resultPtr, &length);
	if ((length > 0) && (string[length - 1] == '\n')) {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);

    return result;







|







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
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 (c) 2000 Ajuba Solutions
 * Copyright (c) 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"






|
|







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
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 Tcl_WideInt	TransformWideSeekProc(ClientData instanceData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);

/*
 * Forward declarations of internal procedures. Secondly the procedures for
 * handling and generating fileeevents.
 */

static void		TransformChannelHandlerTimer(ClientData clientData);







|
|







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
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 = TclGetByteArrayFromObj(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 = TclGetByteArrayFromObj(resObj, &resLen);
	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
	break;

    case TRANSMIT_IBUF:
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(resObj, &resLen);
	ResultAdd(&dataPtr->result, resBuf, resLen);
	break;

    case TRANSMIT_NUM:
	/*
	 * Interpret result as integer number.
	 */







|









|





|







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
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 Tcl_WideInt
TransformWideSeekProc(
    ClientData instanceData,	/* The channel to manipulate. */
    Tcl_WideInt 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);
    ClientData 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.
	 */








|


|








|







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
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 (c) 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"












|







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
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
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 Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt 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 void     TimerRunRead(ClientData clientData);
static void     TimerRunWrite(ClientData clientData);

/*
 * The C layer channel type/driver definition used by the reflection. This is
 * a version 3 structure.
 */

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
    NULL		   /* truncate */
};

/*
 * Instance data for a reflected channel. ===========================
 */

typedef struct {







|
|






>
>




|
<













|









|







40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

62
63
64
65
66
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
204

205
206
207
208
209
210
211
    "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) | \
	FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL))


#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	(x & FLAG(f))







>













>









|
>







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
234

235
236
237
238
239
240
241
    ForwardedInput,
    ForwardedOutput,
    ForwardedSeek,
    ForwardedWatch,
    ForwardedBlock,
    ForwardedSetOpt,
    ForwardedGetOpt,
    ForwardedGetOptAll

} 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),







|
>







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
1135
1136
1137
1138
1139
1140
1141
1142

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *







|







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
1168
1169
1170
1171
1172
1173
1174
1175
1176
	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. We simply clean up all
	 * our 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







|
|







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
1372
1373
1374
1375
1376
1377
1378
1379
            goto error;
	}

	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    bytev = TclGetByteArrayFromObj(resObj, &bytec);

    if ((size_t)toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
	goto invalid;
    }

    *errorCodePtr = EOK;







|







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
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
ReflectSeekWide(
    ClientData clientData,
    Tcl_WideInt offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *offObj, *baseObj;
    Tcl_Obj *resObj;		/* Result for 'seek' */
    Tcl_WideInt newLoc;







|


|







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
1996
1997
1998
1999
2000
2001
2002
2003
	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 = TclGetStringFromObj(resObj, &len);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;
    }







|







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
2371
2372
2373
2374
2375
2376
2377
2378
	     *
	     * 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 = TclGetStringFromObj(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);







|







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
3042
3043
3044
3045
3046
3047
3048
3049
	    /*
	     * Process a regular result.
	     */

	    size_t bytec = 0;		/* Number of returned bytes */
	    unsigned char *bytev;	/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(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);







|







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
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248













3249
3250
3251
3252
3253
3254
3255
		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 = TclGetStringFromObj(resObj, &len);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
	}
        Tcl_Release(rcPtr);
	break;














    default:
	/*
	 * Bad operation code.
	 */

	Tcl_Panic("Bad operation code in ForwardProc");







|









>
>
>
>
>
>
>
>
>
>
>
>
>







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
3338
3339
3340
3341
3342
3343
3344
3345

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    size_t len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif








|







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
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 (c) 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"












|







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
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 Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt 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,







|
|







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
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 Tcl_WideInt
ReflectSeekWide(
    ClientData clientData,
    Tcl_WideInt offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    Channel *parent = (Channel *) rtPtr->parent;
    Tcl_WideInt curPos;		/* Position on the device. */








|


|







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
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 = TclGetStringFromObj(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);







|







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
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 = TclGetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {







|







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
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 = TclGetByteArrayFromObj(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
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
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 = TclGetByteArrayFromObj(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
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
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 = TclGetByteArrayFromObj(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
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
2773
2774
2775
2776
2777
2778
2779
2780

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    size_t len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif /* TCL_THREADS */








|







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
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 *) TclGetByteArrayFromObj(bufObj,
		&(p.transform.size));

	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;







|







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
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 = TclGetByteArrayFromObj(resObj, &bytec);
    ResultAdd(&rtPtr->result, bytev, bytec);

    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    return 1;
}

static int







|







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
3148
3149
3150
3151
3152
3153
3154
3155
	    Tcl_DecrRefCount(bufObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    return 0;
	}

	*errorCodePtr = EOK;

	bytev = TclGetByteArrayFromObj(resObj, &bytec);
	res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);

	Tcl_DecrRefCount(bufObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

    if (res < 0) {







|







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
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 = TclGetByteArrayFromObj(resObj, &bytec);
	ResultAdd(&rtPtr->result, bytev, bytec);

	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

    rtPtr->readIsDrained = 1;
    return 1;







|







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
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 = TclGetByteArrayFromObj(resObj, &bytec);
	    res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
	} else {
	    res = 0;
	}
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }








|







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
6
7
8
9
10
11
12
13
/*
 * tclIOSock.c --
 *
 *	Common routines used by all socket based channel types.
 *
 * 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"






|







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
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 (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 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









|
|
|







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
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 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = TclGetStringFromObj(*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);







|
|







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
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 = TclGetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
    }
    if (cwdClientData != 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
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 = TclGetStringFromObj(mElt, &mlen);
		path = TclGetStringFromObj(norm, &len);
		if (path[len-1] == '/') {
		    /*
		     * Deal with the root of the volume.
		     */

		    len--;
		}







|
|







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
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 = TclGetStringFromObj(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;
	}







|







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
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 = TclGetStringFromObj(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);







|















|







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
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 = TclGetStringFromObj(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)));







|







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
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;
    }







|







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
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 = TclGetStringFromObj(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)));







|







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
2650
2651

2652
2653
2654
2655
2656
2657
2658
		 */

		retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd);
		Tcl_IncrRefCount(retVal);
		norm = TclFSNormalizeAbsolutePath(interp,retVal);
		if (norm != NULL) {
		    /*
		     * Assign to global storage the pathname of the current directory
		     * and copy it into thread-local storage as well.

		     *
		     * At system startup multiple threads could in principle
		     * call this function simultaneously, which is a little
		     * peculiar, but should be fine given the mutex locks in
		     * FSUPdateCWD.  Once some value is assigned to the global
		     * variable the 'else' branch below is always taken, which
		     * is simpler.







|
|
>







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
2800
2801
2802
2803
2804
2805
2806
2807
2808
	     * 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 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = TclGetStringFromObj(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:







|
|







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
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
Tcl_FSLoadFile(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Pathname of the file containing the dynamic shared object.
				 */
    const char *sym1, const char *sym2,
				/* Names of two functions to find in the
				 * dynamic shared object. */
    Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **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_PackageInitProc *) procPtrs[0];
	*proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1];
    } else {
	*proc1Ptr = *proc2Ptr = NULL;
    }

    return res;
}








|

















|
|







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
3102
3103
3104
3105
3106
3107
3108
3109
     */


#ifdef hpux
    (void)shlibFile;
    return 1;
#else
    char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");

    if (skipstr && (skipstr[0] != '\0')) {
	return atoi(skipstr);
    }

#ifndef TCL_TEMPLOAD_NO_UNLINK
    (void)shlibFile;







|







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

3786
3787
3788
3789

3790
3791
3792
3793
3794
3795
3796
    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();








>
|
|
|
|
>







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
3979
3980
3981
3982
3983
3984
3985
3986
				 * 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 = TclGetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
	    driveNameLengthPtr, driveNameRef);

    if (type != TCL_PATH_ABSOLUTE) {
	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,







|







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
4086
4087
4088
4089
4090
4091
4092
4093
		while (numVolumes > 0) {
		    Tcl_Obj *vol;
		    size_t len;
		    const char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = TclGetStringFromObj(vol,&len);
		    if ((size_t) pathLen < len) {
			continue;
		    }
		    if (strncmp(strVol, path, len) == 0) {
			type = TCL_PATH_ABSOLUTE;
			if (filesystemPtrPtr != NULL) {
			    *filesystemPtrPtr = fsRecPtr->fsPtr;







|







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
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
 *	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);








|
|
<


|
|
|
|







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
4433
4434
4435
4436
4437
4438
4439
4440
4441
	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 = TclGetStringFromObj(normPath, &normLen);
		cwdStr = TclGetStringFromObj(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].
		     */








|
|







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
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 (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 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"








|
|
|







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
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 = TclGetStringFromObj(objv[2], &length);

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * A prefix cannot match if it is longest.
	 */

	if (length <= elemLength) {
	    if (TclpUtfNcmp2(elemString, string, length) == 0) {







|


|







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
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 = TclGetStringFromObj(objv[2], &length);

    resultString = NULL;
    resultLength = 0;

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * First check if the prefix string matches the element. A prefix
	 * cannot match if it is longest.
	 */

	if ((length > elemLength) ||







|





|







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
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 = TclUtfPrev(&resultString[i+1],
			    resultString) - resultString;
		    break;
		}
	    }
	}
    }
    if (resultLength > 0) {







|







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
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 = TclGetStringFromObj(origObjv[i], &elemLen);
	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);








|







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
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 = TclGetStringFromObj(objv[i], &elemLen);
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);

		len = TclConvertElement(elementStr, elemLen,







|







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
1027
1028
1029
1030
1031
1032
1033
1034
    srcIndex = dstIndex = 1;
    objc = *objcPtr-1;

    while (objc > 0) {
	curArg = objv[srcIndex];
	srcIndex++;
	objc--;
	str = TclGetStringFromObj(curArg, &length);
	if (length > 0) {
	    c = str[1];
	} else {
	    c = 0;
	}

	/*







|







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
1240
1241
1242
1243
1244
1245
1246
1247
				/* Array of command-specific argument
				 * descriptions. */
{
    const Tcl_ArgvInfo *infoPtr;
    int width, numSpaces;
#define NUM_SPACES 20
    static const char spaces[] = "                    ";
    char tmp[TCL_DOUBLE_SPACE];
    Tcl_Obj *msg;

    /*
     * First, compute the width of the widest option key, so that we can make
     * everything line up.
     */








<







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
1290
1291
1292
1293
1294
1295
1296
1297
	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));
	    sprintf(tmp, "%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);







<







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
8
9
10
11
12
13
14
15
16
17
18
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
# 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 (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# 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.

library tcl

# Define the unsupported generic interfaces.

interface tclInt


# 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.

# Replaced by Tcl_FSAccess in 8.4:
#declare 0 {
#    int TclAccess(const char *path, int mode)
#}
#declare 1 {
#    int TclAccessDeleteProc(TclAccessProc_ *proc)
#}
#declare 2 {
#    int TclAccessInsertProc(TclAccessProc_ *proc)
#}
declare 3 {
    void TclAllocateFreeObjects(void)
}
# Replaced by TclpChdir in 8.1:
#  declare 4 {
#      int TclChdir(Tcl_Interp *interp, char *dirName)
#  }
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)
}
# Removed in 9.0:
#declare 8 {
#    int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
#	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
#}

# TclCreatePipeline unofficially exported for use by BLT.

declare 9 {
    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)
}
# Removed in 8.5:
#declare 13 {
#    int TclDoGlob(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
#}
declare 14 {
    int TclDumpMemoryInfo(void *clientData, int flags)
}
# Removed in 8.1:
#  declare 15 {
#      void TclExpandParseValue(ParseValue *pvPtr, int needed)
#  }
declare 16 {
    void TclExprFloatError(Tcl_Interp *interp, double value)
}
# Removed in 8.4:
#declare 17 {
#    int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#}
#declare 18 {
#    int TclFileCopyCmd(Tcl_Interp *interp, int argc, char **argv)
#}
#declare 19 {
#    int TclFileDeleteCmd(Tcl_Interp *interp, int argc, char **argv)
#}
#declare 20 {
#    int TclFileMakeDirsCmd(Tcl_Interp *interp, int argc, char **argv)
#}
#declare 21 {
#    int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv)
#}
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)
}
# Removed in 8.1:
#  declare 26 {
#      char *TclGetCwd(Tcl_Interp *interp)
#  }
# Removed in 8.5:
#declare 27 {
#    int TclGetDate(char *p, unsigned long now, long zone,
#	    unsigned long *timePtr)
#}
declare 28 {
    Tcl_Channel TclpGetDefaultStdChannel(int type)
}
# Removed in 8.4b2:
#declare 29 {
#    Tcl_Obj *TclGetElementOfIndexedArray(Tcl_Interp *interp,
#	    int localIndex, Tcl_Obj *elemPtr, int flags)
#}
# Replaced by char *TclGetEnv(const char *name, Tcl_DString *valuePtr) in 8.1:
#  declare 30 {
#      char *TclGetEnv(const char *name)
#  }
declare 31 {
    const char *TclGetExtension(const char *name)
}
declare 32 {
    int TclGetFrame(Tcl_Interp *interp, const char *str,
	    CallFrame **framePtrPtr)
}
# Removed in 8.5:
#declare 33 {
#    TclCmdProcType TclGetInterpProc(void)
#}
# Removed in 9.0:
#declare 34 {deprecated {Use Tcl_GetIntForIndex}} {
#    int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
#	    int endValue, int *indexPtr)
#}
# Removed in 8.4b2:
#declare 35 {
#    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    int flags)
#}
# Removed in 8.6a2:
#declare 36 {
#    int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
#}
declare 37 {
    int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName)
}
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)
}
# Removed in 8.5a2:
#declare 43 {
#    int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
declare 44 {
    int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr)
}
declare 45 {
    int TclHideUnsafeCommands(Tcl_Interp *interp)
}
declare 46 {
    int TclInExit(void)
}
# Removed in 8.4b2:
#declare 47 {
#    Tcl_Obj *TclIncrElementOfIndexedArray(Tcl_Interp *interp,
#	    int localIndex, Tcl_Obj *elemPtr, long incrAmount)
#}
# Removed in 8.4b2:
#declare 48 {
#    Tcl_Obj *TclIncrIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    long incrAmount)
#}
#declare 49 {
#    Tcl_Obj *TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
#	    Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)
#}
# Removed in 9.0:
#declare 50 {
#    void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr,
#	    Namespace *nsPtr)
#}
declare 51 {
    int TclInterpInit(Tcl_Interp *interp)
}
# Removed in 8.5a2:
#declare 52 {
#    int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
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)
}
# Replaced with TclpLoadFile in 8.1:
#  declare 56 {
#      int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
#  	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
#  	    Tcl_PackageInitProc **proc2Ptr)
#  }
# Signature changed to take a length in 8.1:
#  declare 57 {
#      int TclLooksLikeInt(char *p)
#  }
declare 58 {
    Var *TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags, const char *msg, int createPart1, int createPart2,
	    Var **arrayPtrPtr)
}
# Replaced by Tcl_FSMatchInDirectory in 8.4
#declare 59 {
#    int TclpMatchFiles(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *dirPtr, char *pattern, char *tail)
#}
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)
}
# Removed in 8.5a2:
#declare 65 {
#    int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
#	    Tcl_Obj *const objv[], int flags)
#}
#declare 66 {
#    int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc)
#}
#declare 67 {
#    int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
#}
# Replaced by Tcl_FSAccess in 8.4:
#declare 68 {
#    int TclpAccess(const char *path, int mode)
#}
declare 69 {
    void *TclpAlloc(size_t size)
}
#declare 70 {
#    int TclpCopyFile(const char *source, const char *dest)
#}
#declare 71 {
#    int TclpCopyDirectory(const char *source, const char *dest,
#	    Tcl_DString *errorPtr)
#}
#declare 72 {
#    int TclpCreateDirectory(const char *path)
#}
#declare 73 {
#    int TclpDeleteFile(const char *path)
#}
declare 74 {
    void TclpFree(void *ptr)
}
declare 75 {
    Tcl_WideUInt TclpGetClicks(void)
}
declare 76 {
    Tcl_WideUInt TclpGetSeconds(void)
}

# Removed in 9.0:
#declare 77 {
#    void TclpGetTime(Tcl_Time *time)
#}
# Removed in 8.6:
#declare 78 {
#    int TclpGetTimeZone(unsigned long time)
#}
# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
#    int TclpListVolumes(Tcl_Interp *interp)
#}
# Replaced by Tcl_FSOpenFileChannel in 8.4:
#declare 80 {
#    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,
#	    char *modeString, int permissions)
#}
declare 81 {
    void *TclpRealloc(void *ptr, size_t size)
}
#declare 82 {
#    int TclpRemoveDirectory(const char *path, int recursive,
#	    Tcl_DString *errorPtr)
#}
#declare 83 {
#    int TclpRenameFile(const char *source, const char *dest)
#}
# Removed in 8.1:
#  declare 84 {
#      int TclParseBraces(Tcl_Interp *interp, char *str, char **termPtr,
#  	    ParseValue *pvPtr)
#  }
#  declare 85 {
#      int TclParseNestedCmd(Tcl_Interp *interp, char *str, int flags,
#  	    char **termPtr, ParseValue *pvPtr)
#  }
#  declare 86 {
#      int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar,
#  	    int flags, char **termPtr, ParseValue *pvPtr)
#  }
#  declare 87 {
#      void TclPlatformInit(Tcl_Interp *interp)
#  }
# Removed in 9.0:
#declare 88 {
#    char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp,
#	    const char *name1, const char *name2, int flags)
#}
declare 89 {
    int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
	    Tcl_Command cmd)
}
# Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG):
#  declare 90 {
#      void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#  }
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)
}
# Removed in 8.5:
#declare 94 {
#    int TclProcInterpProc(void *clientData, Tcl_Interp *interp,
#	    int argc, const char **argv)
#}
# Replaced by Tcl_FSStat in 8.4:
#declare 95 {
#    int TclpStat(const char *path, Tcl_StatBuf *buf)
#}
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 8.4b2:
#declare 99 {
#    Tcl_Obj *TclSetElementOfIndexedArray(Tcl_Interp *interp, int localIndex,
#	    Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int flags)
#}
# Removed in 8.4b2:
#declare 100 {
#    Tcl_Obj *TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    Tcl_Obj *objPtr, int flags)
#}
declare 101 {
    const char *TclSetPreInitScript(const char *string)
}
declare 102 {
    void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 {
    int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
	    int *portPtr)
}
# Removed in 9.0:
#declare 104 {
#    int TclSockMinimumBuffersOld(int sock, int size)
#}
# Replaced by Tcl_FSStat in 8.4:
#declare 105 {
#    int TclStat(const char *path, Tcl_StatBuf *buf)
#}
#declare 106 {
#    int TclStatDeleteProc(TclStatProc_ *proc)
#}
#declare 107 {
#    int TclStatInsertProc(TclStatProc_ *proc)
#}
declare 108 {
    void TclTeardownNamespace(Namespace *nsPtr)
}
declare 109 {
    int TclUpdateReturnInfo(Interp *iPtr)
}
declare 110 {







|
|
|









>






<
<
<
<
<
<
<
<
<
<



<
<
<
<










<
<
<
<
<
<

<
















<
<
<
<
<



<
<
<
<



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<















<
<
<
<
<
<
<
<
<



<
<
<
<
<
<
<
<
<







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















<
<
<
<
<
<
<
<






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<



<
<
<
<
<











<
<
<
<
<
<
<
<
<
<





<
<
<
<
<

















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<



<
<
<
<
<
<
<
<
<
<
<
<
<




|


|

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




<
<
<
<











<
<
<
<
<
<
<
<
<










|
<
<
<
<
<
|
|
<

<
<
<







<
<
<
<
<
<
<
<
<
<
<
<
<
<







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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
# 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)
}
# Removed in 9.0:
#declare 112 {
#    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 113 {
#    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
#	    void *clientData, Tcl_NamespaceDeleteProc *deleteProc)
#}
# Removed in 9.0:
#declare 114 {
#    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
#}
# Removed in 9.0:
#declare 115 {
#    int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    const char *pattern, int resetListFirst)
#}
# Removed in 9.0:
#declare 116 {
#    Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
#	    Tcl_Namespace *contextNsPtr, int flags)
#}
# Removed in 9.0:
#declare 117 {
#    Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
#	    Tcl_Namespace *contextNsPtr, int flags)
#}
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)
}
# Removed in 9.0:
#declare 121 {
#    int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    const char *pattern)
#}
# Removed in 9.0:
#declare 122 {
#    Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 123 {
#    void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
#	    Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 124 {
#    Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
#}
# Removed in 9.0:
#declare 125 {
#    Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
#}
declare 126 {
    void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
	    Tcl_Obj *objPtr)
}
# Removed in 9.0:
#declare 127 {
#    int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    const char *pattern, int allowOverwrite)
#}
declare 128 {
    void Tcl_PopCallFrame(Tcl_Interp *interp)
}
declare 129 {
    int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr,
	    Tcl_Namespace *nsPtr, int isProcCallFrame)
}
declare 130 {
    int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name)
}
declare 131 {
    void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr,
	    Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
	    Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 132 {
    int TclpHasSockets(Tcl_Interp *interp)
}
# Removed in 9.0
#declare 133 {
#    struct tm *TclpGetDate(const time_t *time, int useGMT)
#}
# Removed in 8.5
#declare 134 {
#    size_t TclpStrftime(char *s, size_t maxsize, const char *format,
#	    const struct tm *t, int useGMT)
#}
#declare 135 {
#    int TclpCheckStackSpace(void)
#}

# Added in 8.1:

#declare 137 {
#   int TclpChdir(const char *dirName)
#}
declare 138 {
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
#    int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
#	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
#	    Tcl_PackageInitProc **proc2Ptr, void **clientDataPtr)
#}
#declare 140 {
#    int TclLooksLikeInt(const char *bytes, int length)
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CompileHookProc *hookProc, void *clientData)







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




<
<
<
<
<


















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<



<
<
<
<
<
<
<
<







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
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
}
declare 148 {
    TclHandle TclHandlePreserve(TclHandle handle)
}
declare 149 {
    void TclHandleRelease(TclHandle handle)
}

# Added for Tcl 8.2

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)
}

# moved to tclTest.c (static) in 8.3.2/8.4a2
#declare 154 {
#    int TclTestChannelCmd(void *clientData,
#    Tcl_Interp *interp, int argc, char **argv)
#}
#declare 155 {
#    int TclTestChannelEventCmd(void *clientData,
#	     Tcl_Interp *interp, int argc, char **argv)
#}

declare 156 {
    void TclRegError(Tcl_Interp *interp, const char *msg,
	    int status)
}
declare 157 {
    Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
# REMOVED - use public Tcl_SetStartupScript()
#declare 158 {
#    void TclSetStartupScriptFileName(const char *filename)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 159 {
#    const char *TclGetStartupScriptFileName(void)
#}
#declare 160 {
#    int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *dirPtr, char *pattern, char *tail,
#	    GlobTypeData *types)
#}

# new in 8.3.2/8.4a2
declare 161 {
    int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan,
	    Tcl_Obj *cmdObjPtr)
}
declare 162 {
    void TclChannelEventScriptInvoker(void *clientData, int flags)
}







<
<
<













<
<
<
<
<
<
<
<
<
<
<







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
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

# New function due to TIP #33
declare 166 {
    int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    int index, Tcl_Obj *valuePtr)
}

# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
# REMOVED - use public Tcl_SetStartupScript()
#declare 167 {
#    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 168 {
#    Tcl_Obj *TclGetStartupScriptPath(void)
#}
# 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)
}

# added for 8.4.2

declare 173 {
    int TclUniCharMatch(const Tcl_UniChar *string, size_t strLen,
	    const Tcl_UniChar *pattern, size_t ptnLen, int flags)
}

# added for 8.4.3

#declare 174 {
#    Tcl_Obj *TclIncrWideVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
#	    Tcl_Obj *part2Ptr, Tcl_WideInt wideIncrAmount, int part1NotParsed)
#}

# Factoring out of trace code

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)
}
# TIP 338 made these public - now declared in tcl.h
#declare 178 {
#    void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
#}
#declare 179 {
#    Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
#}

# REMOVED
# Allocate lists without copying arrays
# declare 180 {
#    Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
# }
#declare 181 {
#    Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
#	    const char *file, int line)
#}

# Removed in 9.0
#declare 182 {
#     struct tm *TclpLocaltime(const time_t *clock)
#}
# Removed in 9.0
#declare 183 {
#     struct tm *TclpGmtime(const time_t *clock)
#}

# For the new "Thread Storage" subsystem.

### REMOVED on grounds it should never have been exposed. All these
### functions are now either static in tclThreadStorage.c or
### MODULE_SCOPE.
# declare 184 {
#      void TclThreadStorageLockInit(void)
# }
# declare 185 {
#      void TclThreadStorageLock(void)
# }
# declare 186 {
#      void TclThreadStorageUnlock(void)
# }
# declare 187 {
#      void TclThreadStoragePrint(FILE *outFile, int flags)
# }
# declare 188 {
#      Tcl_HashTable *TclThreadStorageGetHashTable(Tcl_ThreadId id)
# }
# declare 189 {
#      Tcl_HashTable *TclThreadStorageInit(Tcl_ThreadId id, void *reserved)
# }
# declare 190 {
#      void TclThreadStorageDataKeyInit(Tcl_ThreadDataKey *keyPtr)
# }
# declare 191 {
#      void *TclThreadStorageDataKeyGet(Tcl_ThreadDataKey *keyPtr)
# }
# declare 192 {
#      void TclThreadStorageDataKeySet(Tcl_ThreadDataKey *keyPtr, void *data)
# }
# declare 193 {
#      void TclFinalizeThreadStorageThread(Tcl_ThreadId id)
# }
# declare 194 {
#      void TclFinalizeThreadStorage(void)
# }
# declare 195 {
#      void TclFinalizeThreadStorageData(Tcl_ThreadDataKey *keyPtr)
# }
# declare 196 {
#      void TclFinalizeThreadStorageDataKey(Tcl_ThreadDataKey *keyPtr)
# }

#
# Added in tcl8.5a5 for compiler/executor experimentation.
# Disabled in Tcl 8.5.1; experiments terminated. :/
#
#declare 197 {
#    int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
#		        const CmdFrame *invoker, int word)
#}
declare 198 {
    int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CallFrame **framePtrPtr)
}

#declare 199 {
#    int TclMatchIsTrivial(const char *pattern)
#}

# 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,







<
<
<
<
<
<
<
<
<

















<
<
<




<
<
<
<
<
<
<
<
<
<











<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




<
<
<
<
<







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
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
declare 207 {
    int TclpObjAccess(Tcl_Obj *pathPtr, int mode)
}
declare 208 {
    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp,
	    Tcl_Obj *pathPtr, int mode, int permissions)
}
# Made public by TIP 258
#declare 209 {
#    Tcl_Obj *TclGetEncodingSearchPath(void)
#}
#declare 210 {
#    int TclSetEncodingSearchPath(Tcl_Obj *searchPath)
#}
#declare 211 {
#    const char *TclpGetEncodingNameFromEnvironment(Tcl_DString *bufPtr)
#}
declare 212 {
    void TclpFindExecutable(const char *argv0)
}
declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {







<
<
<
<
<
<
<
<
<
<







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
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
    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[])
}
#  Used to be needed for TclOO-extension; unneeded now that TclOO is in the
#  core and NRE-enabled
#  declare 228 {
#      int TclObjInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
#             int skip, ProcErrorProc *errorProc)
#  }
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,







<
<











<
<
<
<
<
<







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
958
959
960
961
962
963


964
965
966
967
968
969
970
declare 234 {
    Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
             int *newPtr)
}
declare 235 {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}


# TIP 337 made this one public
#declare 236 {
#    void TclBackgroundException(Tcl_Interp *interp, int code)
#}



# TIP #285: Script cancellation support.
declare 237 {
    int TclResetCancellation(Tcl_Interp *interp, int force)
}

# NRE functions for "rogue" extensions to exploit NRE; they will need to







<
<
|
|
|
<
>
>







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
1015
1016
1017
1018
1019
1020
1021
1022
}
declare 247 {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
	    Tcl_Channel outChan, Tcl_WideInt 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.







|







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
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
	    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 TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}

# TIP 431: temporary directory creation function
declare 258 {
    Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
	    Tcl_Obj *basenameObj)
}
# TIP 542
declare 259 {
    void TclAppendUnicodeToObj(Tcl_Obj *objPtr,
	    const Tcl_UniChar *unicode, size_t length)
}

declare 260 {
    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

################################
# Windows specific functions

declare 0 win {
    void TclWinConvertError(int errCode)
}
# Removed in 9.0:
#declare 1 win {
#    void TclWinConvertWSAError(int errCode)
#}
# Removed in 9.0:


#declare 2 win {

#    struct servent *TclWinGetServByName(const char *nm,
#	    const char *proto)
#}
# Removed in 9.0:

#declare 3 win {
#    int TclWinGetSockOpt(SOCKET s, int level, int optname,
#	    char *optval, int *optlen)
#}

declare 4 win {
    void *TclWinGetTclInstance(void)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 5 win {
    int TclUnixWaitForFile(int fd, int mask, int timeout)
}
# Removed in 8.1:
#  declare 5 win {
#      HINSTANCE TclWinLoadLibrary(char *name)
#  }
# Removed in 9.0:
#declare 6 win {
#    unsigned short TclWinNToHS(unsigned short ns)
#}
# Removed in 9.0:


#declare 7 win {
#    int TclWinSetSockOpt(SOCKET s, int level, int optname,
#	    const char *optval, int optlen)
#}

declare 8 win {
    size_t TclpGetPid(Tcl_Pid pid)
}
# Removed in 9.0:
#declare 9 win {
#    int TclWinGetPlatformId(void)
#}
# Removed in 9.0:
#declare 10 win {
#    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
#}
# Removed in 8.3.1 (for Win32s only):
#declare 10 win {
#    int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}

# Pipe channel functions

declare 11 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 win {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
declare 15 win {
    int TclpCreateProcess(Tcl_Interp *interp, int argc,
	    const char **argv, TclFile inputFile, TclFile outputFile,
	    TclFile errorFile, Tcl_Pid *pidPtr)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 16 win {
    int TclpIsAtty(int fd)
}
# Signature changed in 8.1:
#  declare 16 win {
#      TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr)
#  }
#  declare 17 win {
#      char *TclpGetTZName(void)
#  }
# new for 8.5.12+ Cygwin only
declare 17 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 win {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
    void TclWinAddProcess(void *hProcess, size_t id)
}
# Removed in 9.0:
#declare 21 win {
#    char *TclpInetNtoa(struct in_addr addr)
#}
# removed permanently for 8.4
#declare 21 win {
#    void TclpAsyncMark(Tcl_AsyncHandler async)
#}

# Added in 8.1:
declare 22 win {
    TclFile TclpCreateTempFile(const char *contents)
}
# Removed in 8.6:
#declare 23 win {
#    char *TclpGetTZName(int isdst)
#}
declare 24 win {
    char *TclWinNoBackslash(char *path)
}
# replaced by generic TclGetPlatform
#declare 25 win {
#    TclPlatformType *TclWinGetPlatform(void)
#}
# Removed in 9.0:
#declare 26 win {
#    void TclWinSetInterfaces(int wide)
#}

# Added in Tcl 8.3.3 / 8.4

declare 27 win {
    void TclWinFlushDirtyChannels(void)
}

# Added in 8.4.2

# Removed in 9.0:
#declare 28 win {
#    void TclWinResetInterfaces(void)
#}

################################
# Unix specific functions

# Pipe channel functions

declare 0 unix {
    void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 1 unix {
    int TclpCloseFile(TclFile file)
}
declare 2 unix {
    Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
	    TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 3 unix {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
declare 4 unix {
    int TclpCreateProcess(Tcl_Interp *interp, int argc,
	    const char **argv, TclFile inputFile, TclFile outputFile,
	    TclFile errorFile, Tcl_Pid *pidPtr)
}
declare 5 unix {
    int TclUnixWaitForFile_(int fd, int mask, int timeout)
}
declare 6 unix {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 7 unix {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 8 unix {
    int TclUnixWaitForFile(int fd, int mask, int timeout)
}

# Added in 8.1:

declare 9 unix {
    TclFile TclpCreateTempFile(const char *contents)
}

# Added in 8.4:

# Removed in 9.0:
#declare 10 unix {
#    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
#}
# Removed in 9.0:
#declare 11 unix {
#    struct tm *TclpLocaltime_unix(const time_t *clock)
#}
# Removed in 9.0:
#declare 12 unix {
#    struct tm *TclpGmtime_unix(const time_t *clock)
#}
# Removed in 9.0:
#declare 13 unix {
#    char *TclpInetNtoa(struct in_addr addr)
#}

# Added in 8.5:

declare 14 unix {
    int TclUnixCopyFile(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
}

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

declare 15 {unix macosx} {
    int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
}
declare 16 {unix macosx} {
    int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj *attributePtr)
}
declare 17 {unix macosx} {
    int TclMacOSXCopyFileAttributes(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr)
}
declare 18 {unix macosx} {
    int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName,
	    const char *fileName, Tcl_StatBuf *statBufPtr,
	    Tcl_GlobTypeData *types)
}
declare 19 {unix macosx} {
    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}
declare 22 {unix macosx} {
    TclFile TclpCreateTempFile_(const char *contents)
}

declare 29 {win unix} {
    int TclWinCPUID(int index, int *regs)
}
# Added in 8.6; core of TclpOpenTemporaryFile
declare 30 {win unix} {
    int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj,
	    Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj)
}

# Local Variables:
# mode: tcl
# End:







|
|







<
<
<
<
|
<
|



<









|

<
<
<
|
|
|

|
>
>
|
>
|
<
<
<
>
|
|
<
<
>
|


<
|


<
<
<
<
<
|
<
<
<
>
>
|
<
|
<
>
|


<
|
<
<
<
<
<
<
<
<
<
<
|
<
|
|



|


|


|
|

|




<
|


<
<
<
<
<
<
<
<
|




|

>
>
>

|

|


<
<
<
<
<
<
<
<
<
<
|
|

<
<
<
<
|


<
<
<
<
<
<
<
<
<
<
<
|


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|


<
|







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
2675
2676
2677
2678
2679
2680
2681
2682
 *----------------------------------------------------------------
 */

MODULE_SCOPE char *tclNativeExecutableName;
MODULE_SCOPE int tclFindExecutableSearchDone;
MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;

MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;

/*
 * TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */







<







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
2978
2979
2980
2981
2982
2983
2984
2985
			    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	TclGetLoadedPackagesEx(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);







|







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
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
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 int	TclpDeleteFile(const void *path);

MODULE_SCOPE void	TclpFinalizeCondition(Tcl_Condition *condPtr);
MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);

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 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);







|
>


>
>
>
>
>
>

>


>













>







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
3112

3113
3114
3115
3116
3117
3118
3119
3120
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,







|
>
|







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
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
			    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 TclUCS4Complete Tcl_UtfCharComplete
#   define TclChar16Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
	    ? ((length) >= 3) : Tcl_UtfCharComplete((src), (length)))
#else
    MODULE_SCOPE int	TclUtfToUCS4(const char *src, int *ucs4Ptr);
    MODULE_SCOPE int	TclUniCharToUCS4(const Tcl_UniChar *src, int *ucs4Ptr);
#   define TclUCS4Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
	    ? ((length) >= 4) : Tcl_UtfCharComplete((src), (length)))
#   define TclChar16Complete Tcl_UtfCharComplete

#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 Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#else
#   ifdef _WIN32
#	define TCL_WIDE_CLICKS 1
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#	define		TclpWideClicksToNanoseconds(clicks) \
				((double)(clicks) * TclpWideClickInMicrosec() * 1000)
#   endif
#endif
MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);

MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void *	TclpThreadCreateKey(void);
MODULE_SCOPE void	TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void	TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void *	TclpThreadGetGlobalTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,







|
<
<

|
|
<
<
<
>


















|
|




|





|







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
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
 * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclGetString(objPtr) \
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr))

#if 0
   static inline char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lenPtr) {
      char *response = Tcl_GetString(objPtr);
      *(lenPtr) = objPtr->length;
      return response;
   }
   static inline Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lenPtr) {
      Tcl_UniChar *response = Tcl_GetUnicodeFromObj(objPtr, NULL);
      *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1);
      return response;
   }
   static inline unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lenPtr) {
      unsigned char *response = Tcl_GetByteArrayFromObj(objPtr, NULL);
      if (response) {
          *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1 + 1);
      }
      return response;
   }
#else
#define TclGetStringFromObj(objPtr, lenPtr) \
    (((objPtr)->bytes \
	    ? NULL : Tcl_GetString((objPtr)), \
	    *(lenPtr) = (objPtr)->length, (objPtr)->bytes))
#define TclGetUnicodeFromObj(objPtr, lenPtr) \
    (Tcl_GetUnicodeFromObj((objPtr), NULL), \
	    *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \
	    Tcl_GetUnicodeFromObj((objPtr), NULL))
#define TclGetByteArrayFromObj(objPtr, lenPtr) \
    (Tcl_GetByteArrayFromObj((objPtr), NULL) ? \
	(*(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1 + 1), \
	(unsigned char *)(((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1) + 3)) : NULL)
#endif

/*
 *----------------------------------------------------------------
 * 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);







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
	_count = (numBytes) - _i; \
	if (_i) { \
	    _count += Tcl_NumUtfChars((bytes) + _count, _i); \
	} \
	(numChars) = _count; \
    } while (0);

#define TclUtfPrev(src, start) \
	(((src) < (start) + 2) ? (start) : \
	((unsigned char) *((src) - 1)) < 0x80 ? (src) - 1 : \
	Tcl_UtfPrev(src, start))

/*
 *----------------------------------------------------------------
 * 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







<
<
<
<
<







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
4704
4705
4706
4707
4708
4709
4710
4711
 * this macro is:
 *
 * MODULE_SCOPE int	TclUniCharNcmp(const Tcl_UniChar *cs,
 *			    const Tcl_UniChar *ct, unsigned long n);
 *----------------------------------------------------------------
 */

#ifdef WORDS_BIGENDIAN
#   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:







|







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
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
 *----------------------------------------------------------------------
 *
 * Core procedure added to libtommath for bignum manipulation.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_PackageInitProc 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_PackageInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_PackageInitProc TclThread_Init;
MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_PackageInitProc 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);







|











|
|
|
|
|







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
4855
4856
4857
4858
4859
4860
4861
4862
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)

#define TclNewIndexObj(objPtr, w) \
    (objPtr) = ((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 */







|







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
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
/* 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 */
/* 37 */
EXTERN int		TclGetLoadedPackages(Tcl_Interp *interp,
				const char *targetName);
/* 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 */
/* 44 */
EXTERN int		TclGuessPackageName(const char *fileName,
				Tcl_DString *bufPtr);
/* 45 */
EXTERN int		TclHideUnsafeCommands(Tcl_Interp *interp);
/* 46 */
EXTERN int		TclInExit(void);
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 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
193
194
195
196
197
198
199
200
201
202
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
/* 74 */
EXTERN void		TclpFree(void *ptr);
/* 75 */
EXTERN Tcl_WideUInt	TclpGetClicks(void);
/* 76 */
EXTERN Tcl_WideUInt	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 */







|

|







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
234
235
236
237
238
239
240
241
242
/* 97 */
EXTERN void		TclResetShadowedCmdRefs(Tcl_Interp *interp,
				Command *newCmdPtr);
/* 98 */
EXTERN int		TclServiceIdle(void);
/* Slot 99 is reserved */
/* Slot 100 is reserved */
/* 101 */
EXTERN const char *	TclSetPreInitScript(const char *string);
/* 102 */
EXTERN void		TclSetupEnv(Tcl_Interp *interp);
/* 103 */
EXTERN int		TclSockGetPort(Tcl_Interp *interp, const char *str,
				const char *proto, int *portPtr);
/* Slot 104 is reserved */
/* Slot 105 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
508


509
510
511
512
513
514
515
EXTERN void		TclGetSrcInfoForPc(CmdFrame *contextPtr);
/* 234 */
EXTERN Var *		TclVarHashCreateVar(TclVarHashTable *tablePtr,
				const char *key, int *newPtr);
/* 235 */
EXTERN void		TclInitVarHashTable(TclVarHashTable *tablePtr,
				Namespace *nsPtr);
/* Slot 236 is reserved */


/* 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,







|
>
>







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
544
545
546
547
548
549
550
551
				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,
				Tcl_WideInt 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 */







|







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
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
				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		TclStaticPackage(Tcl_Interp *interp,
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj);
/* 259 */
EXTERN void		TclAppendUnicodeToObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, size_t length);
/* 260 */
EXTERN unsigned char *	TclGetBytesFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, size_t *lengthPtr);

typedef struct TclIntStubs {
    int magic;
    void *hooks;








|
|
|
|




<
<
<







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
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
    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);
    int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */
    int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
    TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
    int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
    Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
    const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
    void (*reserved43)(void);
    int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
    int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
    int (*tclInExit) (void); /* 46 */
    void (*reserved47)(void);
    void (*reserved48)(void);
    void (*reserved49)(void);
    void (*reserved50)(void);
    int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */







|






|







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
670
671
672
673
674
675
676
677
678
    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 */
    Tcl_WideUInt (*tclpGetClicks) (void); /* 75 */
    Tcl_WideUInt (*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);







|
|







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
696
697
698
699
700
701
702
703
    void (*reserved94)(void);
    void (*reserved95)(void);
    int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
    void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
    int (*tclServiceIdle) (void); /* 98 */
    void (*reserved99)(void);
    void (*reserved100)(void);
    const char * (*tclSetPreInitScript) (const char *string); /* 101 */
    void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
    int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
    void (*reserved104)(void);
    void (*reserved105)(void);
    void (*reserved106)(void);
    void (*reserved107)(void);
    void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */







|







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
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
    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 (*reserved236)(void);
    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, Tcl_WideInt 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 (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
    Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
    void (*tclAppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 259 */
    unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *lengthPtr); /* 260 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif







|











|








|

<
|







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
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
	(tclIntStubsPtr->tclGetExtension) /* 31 */
#define TclGetFrame \
	(tclIntStubsPtr->tclGetFrame) /* 32 */
/* Slot 33 is reserved */
/* Slot 34 is reserved */
/* Slot 35 is reserved */
/* Slot 36 is reserved */
#define TclGetLoadedPackages \
	(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
#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 */
#define TclGuessPackageName \
	(tclIntStubsPtr->tclGuessPackageName) /* 44 */
#define TclHideUnsafeCommands \
	(tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
#define TclInExit \
	(tclIntStubsPtr->tclInExit) /* 46 */
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 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
1019
1020
1021
1022
1023
1024
1025
1026
1027
	(tclIntStubsPtr->tclRenameCommand) /* 96 */
#define TclResetShadowedCmdRefs \
	(tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */
#define TclServiceIdle \
	(tclIntStubsPtr->tclServiceIdle) /* 98 */
/* Slot 99 is reserved */
/* Slot 100 is reserved */
#define TclSetPreInitScript \
	(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
#define TclSetupEnv \
	(tclIntStubsPtr->tclSetupEnv) /* 102 */
#define TclSockGetPort \
	(tclIntStubsPtr->tclSockGetPort) /* 103 */
/* Slot 104 is reserved */
/* Slot 105 is reserved */
/* Slot 106 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

1228
1229
1230
1231
1232
1233
1234
1235
	(tclIntStubsPtr->tclEvalObjEx) /* 232 */
#define TclGetSrcInfoForPc \
	(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
#define TclVarHashCreateVar \
	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#define TclInitVarHashTable \
	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */

/* Slot 236 is reserved */
#define TclResetCancellation \
	(tclIntStubsPtr->tclResetCancellation) /* 237 */
#define TclNRInterpProc \
	(tclIntStubsPtr->tclNRInterpProc) /* 238 */
#define TclNRInterpProcCore \
	(tclIntStubsPtr->tclNRInterpProcCore) /* 239 */
#define TclNRRunCallbacks \







>
|







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
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
	(tclIntStubsPtr->tclPtrSetVar) /* 253 */
#define TclPtrIncrObjVar \
	(tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */
#define TclPtrObjMakeUpvar \
	(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
	(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticPackage \
	(tclIntStubsPtr->tclStaticPackage) /* 257 */
#define TclpCreateTemporaryDirectory \
	(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
#define TclAppendUnicodeToObj \
	(tclIntStubsPtr->tclAppendUnicodeToObj) /* 259 */
#define TclGetBytesFromObj \
	(tclIntStubsPtr->tclGetBytesFromObj) /* 260 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#undef Tcl_StaticPackage
#define Tcl_StaticPackage \
	(tclIntStubsPtr->tclStaticPackage)
#endif /* defined(USE_TCL_STUBS) */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLINTDECLS */







|
|


<
<

|






|
|
|






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
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
#endif

/*
 * Exported function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 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 int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* Slot 11 is reserved */


/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,

				Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj *attributePtr);
/* 17 */
EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
				const char *dst,
				const Tcl_StatBuf *statBufPtr);

/* 18 */
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* Slot 20 is reserved */

/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */

/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */

/* Slot 28 is reserved */
/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */

/* 0 */
EXTERN void		TclWinConvertError(int errCode);
/* Slot 1 is reserved */



/* Slot 2 is reserved */
/* Slot 3 is reserved */

/* 4 */
EXTERN void *		TclWinGetTclInstance(void);
/* 5 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* Slot 6 is reserved */

/* Slot 7 is reserved */

/* 8 */
EXTERN size_t		TclpGetPid(Tcl_Pid pid);
/* Slot 9 is reserved */

/* Slot 10 is reserved */
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
EXTERN int		TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 14 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);

/* 15 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclpIsAtty(int fd);
/* 17 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 18 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, 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 */
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 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 int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* Slot 11 is reserved */


/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,

				Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj *attributePtr);
/* 17 */
EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
				const char *dst,
				const Tcl_StatBuf *statBufPtr);

/* 18 */
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* Slot 20 is reserved */

/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */

/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */

/* Slot 28 is reserved */
/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* MACOSX */

typedef struct TclIntPlatStubs {
    int magic;
    void *hooks;

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    int (*tclpCloseFile) (TclFile file); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    void (*reserved10)(void);
    void (*reserved11)(void);
    void (*reserved12)(void);
    void (*reserved13)(void);
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
    void (*reserved20)(void);
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    void (*tclWinConvertError) (int errCode); /* 0 */
    void (*reserved1)(void);

    void (*reserved2)(void);
    void (*reserved3)(void);
    void * (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    void (*reserved6)(void);
    void (*reserved7)(void);
    size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    void (*reserved9)(void);
    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 (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    int (*tclpCloseFile) (TclFile file); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    void (*reserved10)(void);
    void (*reserved11)(void);
    void (*reserved12)(void);
    void (*reserved13)(void);
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
    void (*reserved20)(void);
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;

extern const TclIntPlatStubs *tclIntPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
#define TclUnixWaitForFile_ \
	(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */

/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */

#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
/* Slot 24 is reserved */

/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */


/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */

#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */


#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
/* Slot 6 is reserved */
/* Slot 7 is reserved */


#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
/* Slot 9 is reserved */


/* Slot 10 is reserved */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
#define TclUnixWaitForFile_ \
	(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */

/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */

#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
/* Slot 24 is reserved */

/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */


/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#define TclWinConvertWSAError TclWinConvertError


#undef TclpCreateTempFile_
#undef TclUnixWaitForFile_
#ifndef MAC_OSX_TCL /* not accessable on Win32/UNIX */
#undef TclMacOSXGetFileAttribute /* 15 */



#undef TclMacOSXSetFileAttribute /* 16 */



#undef TclMacOSXCopyFileAttributes /* 17 */


#undef TclMacOSXMatchType /* 18 */
#undef TclMacOSXNotifierAddRunLoopMode /* 19 */



#endif

#if !defined(_WIN32)
#   undef TclpGetPid
#   define TclpGetPid(pid) ((size_t)(pid))
#endif

#endif /* _TCLINTPLATDECLS */







|
<
<









|
<
<
<

|





|



|
>
>



|
|
<

|
|
>
|

|
<
<

<
|
|
>
|
<
<
<
<



|
>




|
>


|
>









>
|
|
|
>
>
>
|
<
>




|
>
|
>


|
>





|

|



|
>












|

|




|
















|
<
<









|
<
<
<

|





|



|
>
>



|
|
<

|
|
>
|

|
<
<

<
|
|
>
|
<
<
<
<



|
>




|
>


|
>














|



|
|


|


|


|
|
|
|
|

|



|


|





<
|
>
|
|


|
|

|


|
|
|



|
|


|










|



|
|


|


|


|
|
|
|
|

|



|


|



















|
<






|
|
|
|




|
|



|
>


|
|
|
|
|
|
|
|
>
|
|
|
|
<




|
>


<
>
>







>
|
|
<
|
|
>
>




|
|
>
>


<
>
>



|
|
|
|
|
|






|
|
|
|



|
|














|
<






|
|
|
|




|
|



|
>


|
|
|
|
|
|
|
|
>
|
|
|
|
<




|
>


<
>
>













|
>

<
<
|
|
>
>
>
|
>
>
>
|
>
>
|
|
>
>
>








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
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 (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2004 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|
|







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
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;


/*
 *----------------------------------------------------------------------
 *
 * TclSetPreInitScript --
 *
 *	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 *
TclSetPreInitScript(
    const char *string)		/* Pointer to a script. */
{
    const char *prevString = tclPreInitScript;
    tclPreInitScript = string;
    return(prevString);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Init --
 *







|














|




|







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
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) TclGetStringFromObj(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) TclGetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {







|
















|







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
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;
	int 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) TclGetStringFromObj(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) TclGetStringFromObj(objv[i+1], &milliLen);
		if (milliLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "milliseconds must be at least 0", -1));
		    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) TclGetStringFromObj(objv[i+1], &secLen);
		if (secLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "seconds must be at least 0", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		limitMoment.sec = tmp;
		break;
	    }
	}
	if (milliObj != NULL || secObj != NULL) {
	    if (milliObj != NULL) {
		/*
		 * Setting -milliseconds but clearing -seconds, or resetting







|










|
















|



|


|
|
|




|



|



|


|
|
|




|







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
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 (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2008 Rene Zaumseil
 * Copyright (c) 2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"








|
|
|
|







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
637
638
639
640
641
642
643
644
SetInvalidRealFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)
{
    size_t length;
    const char *str, *endPtr;

    str = TclGetStringFromObj(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) {







|







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
682
683
684
685
686
687
688
689

static int
GetInvalidIntFromObj(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    size_t length;
    const char *str = TclGetStringFromObj(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] == '+');







|







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
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 = TclGetStringFromObj(valueObj, &valueLength);
	pp = (char **) linkPtr->addr;

	*pp = (char *)Tcl_Realloc(*pp, ++valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) TclGetStringFromObj(valueObj, &valueLength);
	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 *) TclGetByteArrayFromObj(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 {







|







|














|







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
6
7
8
9
10
11
12
13
14
15
/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <assert.h>





|
|
|







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
543
544
545
546
547
548
549
550

    ListGetIntRep(listPtr, listRepPtr);

    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objcPtr = 0;
	    *objvPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {







|







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
667
668
669
670
671
672
673
674
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    Tcl_SetListObj(listPtr, 1, &objPtr);
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;







|







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
842
843
844
845
846
847
848
849
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objPtrPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;







|







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
899
900
901
902
903
904
905
906
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *intPtr = 0;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;







|







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
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) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    if (objc == 0) {
		return TCL_OK;
	    }
	    Tcl_SetListObj(listPtr, objc, NULL);
	} else {
	    int result = SetListFromAny(interp, listPtr);







|







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
1787
1788
1789
1790
1791
1792
1793
1794
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(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);
	    }







|







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
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 = TclGetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each
	 * (possible) list element.
	 */

	estCount = TclMaxListLength(nextElem, length, &limit);







|







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
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 = TclGetStringFromObj(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 = TclGetStringFromObj(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);








|












|







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
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 (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"









|
|







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
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 = TclGetStringFromObj(objPtr, &objLength);

	    if ((objLength == length) && ((length == 0)
		    || ((objBytes[0] == bytes[0])
		    && (memcmp(objBytes, bytes, length) == 0)))) {
		/*
		 * A literal was found: return it
		 */







|







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
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 = TclGetStringFromObj(objPtr, &length);
    globalHash = (HashString(bytes, length) & globalTablePtr->mask);
    for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
	    entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }







|







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

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = TclGetStringFromObj(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;







|







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
707
708
709
710
711
712
713
714
		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = TclGetStringFromObj(objPtr, &length);
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;







|







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
836
837
838
839
840
841
842
843
    size_t length, index;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetStringFromObj(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.
     */







|







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
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 = TclGetStringFromObj(entryPtr->objPtr, &length);
	    index = (HashString(bytes, length) & tablePtr->mask);

	    *oldChainPtr = entryPtr->nextPtr;
	    bucketPtr = &tablePtr->buckets[index];
	    entryPtr->nextPtr = *bucketPtr;
	    *bucketPtr = entryPtr;
	}







|







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
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 = TclGetStringFromObj(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");







|







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
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 = TclGetStringFromObj(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");







|







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
7
8
9
10
11
12
13
14
15
16
17
18
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
/*
 * tclLoad.c --
 *
 *	This file provides the generic portion (those that are the same on all
 *	platforms) of Tcl's dynamic loading facilities.
 *
 * 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"

/*
 * The following structure describes a package that has been loaded either
 * dynamically (with the "load" command) or statically (as indicated by a call
 * to TclGetLoadedPackages). All such packages are linked together into a
 * single list for the process. Packages are never unloaded, until the
 * application exits, when TclFinalizeLoad is called, and these structures are
 * freed.
 */

typedef struct LoadedPackage {
    char *fileName;		/* Name of the file from which the package was
				 * loaded. An empty string means the package
				 * is loaded statically. Malloc-ed. */
    char *packageName;		/* Name of package prefix for the package,
				 * properly capitalized (first letter UC,
				 * others LC), no "_", as in "Net".
				 * Malloc-ed. */
    Tcl_LoadHandle loadHandle;	/* Token for the loaded file which should be
				 * passed to (*unLoadProcPtr)() when the file
				 * is no longer needed. If fileName is NULL,
				 * then this field is irrelevant. */
    Tcl_PackageInitProc *initProc;
				/* Initialization function to call to
				 * incorporate this package into a trusted
				 * interpreter. */
    Tcl_PackageInitProc *safeInitProc;
				/* Initialization function to call to
				 * incorporate this package into a safe
				 * interpreter (one that will execute
				 * untrusted scripts). NULL means the package
				 * can't be used in unsafe interpreters. */
    Tcl_PackageUnloadProc *unloadProc;
				/* Finalisation function to unload a package
				 * from a trusted interpreter. NULL means that
				 * the package cannot be unloaded. */
    Tcl_PackageUnloadProc *safeUnloadProc;
				/* Finalisation function to unload a package
				 * from a safe interpreter. NULL means that
				 * the package cannot be unloaded. */
    int interpRefCount;		/* How many times the package has been loaded
				 * in trusted interpreters. */
    int safeInterpRefCount;	/* How many times the package has been loaded
				 * in safe interpreters. */
    struct LoadedPackage *nextPtr;
				/* Next in list of all packages loaded into
				 * this application process. NULL means end of
				 * list. */
} LoadedPackage;

/*
 * TCL_THREADS
 * There is a global list of packages that is anchored at firstPackagePtr.
 * Access to this list is governed by a mutex.
 */

static LoadedPackage *firstPackagePtr = NULL;
				/* First in list of all packages loaded into
				 * this process. */

TCL_DECLARE_MUTEX(packageMutex)

/*
 * The following structure represents a particular package 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 package (if any).
 */

typedef struct InterpPackage {
    LoadedPackage *pkgPtr;	/* Points to detailed information about
				 * package. */
    struct InterpPackage *nextPtr;
				/* Next package in this interpreter, or NULL
				 * for end of list. */
} InterpPackage;

/*
 * Prototypes for functions that are private to this file:
 */

static void		LoadCleanupProc(ClientData clientData,
			    Tcl_Interp *interp);






|








|

|
|
<
<


|
|
|

|
<
<





|

|

|

|

|

|
|

|
|
|

|
|

|

|
|


|



|



|
|


|


|



|


|
|
|
|
|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Tcl_LoadObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *target;
    LoadedPackage *pkgPtr, *defaultPtr;
    Tcl_DString pkgName, tmp, initName, safeInitName;
    Tcl_DString unloadName, safeUnloadName;
    InterpPackage *ipFirstPtr, *ipPtr;
    int code, namesMatch, filesMatch, offset;
    const char *symbols[2];
    Tcl_PackageInitProc *initProc;
    const char *p, *fullFileName, *packageName;
    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







|
|

|


|
|







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
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
	} 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 ?packageName? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }
    fullFileName = TclGetString(objv[1]);

    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&initName);
    Tcl_DStringInit(&safeInitName);
    Tcl_DStringInit(&unloadName);
    Tcl_DStringInit(&safeUnloadName);
    Tcl_DStringInit(&tmp);

    packageName = NULL;
    if (objc >= 3) {
	packageName = TclGetString(objv[2]);
	if (packageName[0] == '\0') {
	    packageName = NULL;
	}
    }
    if ((fullFileName[0] == 0) && (packageName == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must specify either file name or package name", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
		NULL);
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Figure out which interpreter we're going to load the package 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 packages that are currently loaded to see if the
     * package we want is already loaded. We'll use a loaded package 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 package with the same name.
     */

    Tcl_MutexLock(&packageMutex);

    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;
	}
	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
	    /*
	     * Can't have two different packages loaded from the same file.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "file \"%s\" is already loaded for package \"%s\"",
		    fullFileName, pkgPtr->packageName));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
		    "SPLITPERSONALITY", NULL);
	    code = TCL_ERROR;
	    Tcl_MutexUnlock(&packageMutex);
	    goto done;
	}
    }
    Tcl_MutexUnlock(&packageMutex);
    if (pkgPtr == NULL) {
	pkgPtr = defaultPtr;
    }

    /*
     * Scan through the list of packages already loaded in the target
     * interpreter. If the package we want is already loaded there, then
     * there's nothing for us to do.
     */

    if (pkgPtr != NULL) {
	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
		code = TCL_OK;
		goto done;
	    }
	}
    }

    if (pkgPtr == NULL) {
	/*
	 * The desired file isn't currently loaded, so load it. It's an error
	 * if the desired package is a static one.
	 */

	if (fullFileName[0] == 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "package \"%s\" isn't loaded statically", packageName));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}

	/*
	 * Figure out the module name if it wasn't provided explicitly.
	 */

	if (packageName != NULL) {
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	} else {

	    int retc;


	    /*
	     * Threading note - this call used to be protected by a mutex.
	     */

	    retc = TclGuessPackageName(fullFileName, &pkgName);
	    if (!retc) {
		Tcl_Obj *splitPtr, *pkgGuessPtr;
		int pElements;
		const char *pkgGuess;

		/*
		 * The platform-specific code couldn't figure out the module
		 * name. Make a guess by taking the last element of the file
		 * name, stripping off any leading "lib", 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__
		if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
			&& (pkgGuess[2] == 'g')) {
		    pkgGuess += 3;
		}
#endif /* __CYGWIN__ */








		for (p = pkgGuess; *p != 0; p += offset) {
		    offset = TclUtfToUniChar(p, &ch);
		    if ((ch > 0x100)
			    || !(isalpha(UCHAR(ch)) /* INTL: ISO only */
				    || (UCHAR(ch) == '_'))) {
			break;
		    }
		}
		if (p == pkgGuess) {
		    Tcl_DecrRefCount(splitPtr);
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "couldn't figure out package name for %s",
			    fullFileName));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
			    "WHATPACKAGE", NULL);
		    code = TCL_ERROR;
		    goto done;
		}
		Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
		Tcl_DecrRefCount(splitPtr);
	    }
	}

	/*
	 * Fix the capitalization in the package name so that the first
	 * character is in caps (or title case) but the others are all
	 * lower-case.
	 */

	Tcl_DStringSetLength(&pkgName,
		Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));



	/*
	 * Compute the names of the two initialization functions, based on the
	 * package name.
	 */

	TclDStringAppendDString(&initName, &pkgName);
	TclDStringAppendLiteral(&initName, "_Init");
	TclDStringAppendDString(&safeInitName, &pkgName);
	TclDStringAppendLiteral(&safeInitName, "_SafeInit");
	TclDStringAppendDString(&unloadName, &pkgName);
	TclDStringAppendLiteral(&unloadName, "_Unload");
	TclDStringAppendDString(&safeUnloadName, &pkgName);
	TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");

	/*
	 * Call platform-specific code to load the package and find the two
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);
	symbols[1] = NULL;

	Tcl_MutexLock(&packageMutex);
	code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc,
		&loadHandle);
	Tcl_MutexUnlock(&packageMutex);
	if (code != TCL_OK) {
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
	len = strlen(fullFileName) + 1;
	pkgPtr->fileName	   = (char *)Tcl_Alloc(len);
	memcpy(pkgPtr->fileName, fullFileName, len);
	len = Tcl_DStringLength(&pkgName) + 1;
	pkgPtr->packageName	   = (char *)Tcl_Alloc(len);
	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&unloadName));
	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeUnloadName));
	pkgPtr->interpRefCount	   = 0;
	pkgPtr->safeInterpRefCount = 0;

	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		   = firstPackagePtr;
	firstPackagePtr		   = pkgPtr;
	Tcl_MutexUnlock(&packageMutex);

	/*
	 * The Tcl_FindSymbol calls may have left a spurious error message in
	 * the interpreter result.
	 */

	Tcl_ResetResult(interp);
    }

    /*
     * Invoke the package'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 (pkgPtr->safeInitProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't use package in a safe interpreter: no"
		    " %s_SafeInit procedure", pkgPtr->packageName));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	code = pkgPtr->safeInitProc(target);
    } else {
	if (pkgPtr->initProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't attach package to interpreter: no %s_Init procedure",
		    pkgPtr->packageName));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	code = pkgPtr->initProc(target);
    }

    /*
     * Test for whether the initialization failed. If so, transfer the error
     * from the target interpreter to the originating one.
     */








|







|






|

|
|
|


|

|







|














|
|




|


|


|
|


|
|

|
<
<

|





|

|
|



|



|



|
|



|



|
|
|



|
|



|
|

|






|


|




|







|


|
|

>
|
>





<
<
<
<
<
<
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|

>
>
>
>
>
>
>
>
|
|
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
|
|
|
|
|

|
|
>
>



|


|

|

|

|



|






|


|





|


|

|
|
|
|
|
|
|
|


|


|


|
|

|
|
|
|










|




|

|
|





|

|

|
|





|







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
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
	    iPtr->legacyFreeProc = (void (*) (void))-1;
	}
	Tcl_TransferResult(target, code, interp);
	goto done;
    }

    /*
     * Record the fact that the package has been loaded in the target
     * interpreter.
     *
     * Update the proper reference count.
     */

    Tcl_MutexLock(&packageMutex);
    if (Tcl_IsSafe(target)) {
	pkgPtr->safeInterpRefCount++;
    } else {
	pkgPtr->interpRefCount++;
    }
    Tcl_MutexUnlock(&packageMutex);

    /*
     * Refetch ipFirstPtr: loading the package may have introduced additional
     * static packages at the head of the linked list!
     */

    ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
    ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
    ipPtr->pkgPtr = pkgPtr;
    ipPtr->nextPtr = ipFirstPtr;
    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);
    Tcl_DStringFree(&safeInitName);
    Tcl_DStringFree(&unloadName);
    Tcl_DStringFree(&safeUnloadName);
    Tcl_DStringFree(&tmp);
    return code;
}







|





|

|

|

|


|
|


|
|
|




|







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
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
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. */
    LoadedPackage *pkgPtr, *defaultPtr;
    Tcl_DString pkgName, tmp;
    Tcl_PackageUnloadProc *unloadProc;
    InterpPackage *ipFirstPtr, *ipPtr;
    int i, index, code, complain = 1, keepLibrary = 0;
    int trustedRefCount = -1, safeRefCount = -1;
    const char *fullFileName = "";
    const char *packageName;
    static const char *const options[] = {
	"-nocomplain", "-keeplibrary", "--", NULL
    };
    enum unloadOptionsEnum {
	UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST
    };








|
|
|
|



|







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
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
	    i++;
	    goto endOfForLoop;
	}
    }
  endOfForLoop:
    if ((objc-i < 1) || (objc-i > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-switch ...? fileName ?packageName? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	return TCL_ERROR;
    }

    fullFileName = TclGetString(objv[i]);
    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&tmp);

    packageName = NULL;
    if (objc - i >= 2) {
	packageName = TclGetString(objv[i+1]);
	if (packageName[0] == '\0') {
	    packageName = NULL;
	}
    }
    if ((fullFileName[0] == 0) && (packageName == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must specify either file name or package name", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
		NULL);
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Figure out which interpreter we're going to load the package 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 packages that are currently loaded to see if the
     * package we want is already loaded. We'll use a loaded package 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 package with the same name.
     */

    Tcl_MutexLock(&packageMutex);

    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	int namesMatch, filesMatch;

	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;
	}
	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
	    break;
	}
    }
    Tcl_MutexUnlock(&packageMutex);
    if (fullFileName[0] == 0) {
	/*
	 * It's an error to try unload a static package.
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"package \"%s\" is loaded statically and cannot be unloaded",
		packageName));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC",
		NULL);
	code = TCL_ERROR;
	goto done;
    }
    if (pkgPtr == 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 packages already loaded in the target
     * interpreter. If the package we want is already loaded there, then we
     * should proceed with unloading.
     */

    code = TCL_ERROR;
    if (pkgPtr != NULL) {
	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
		code = TCL_OK;
		break;
	    }
	}
    }
    if (code != TCL_OK) {
	/*
	 * The package 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,
     * pkgPtr->unloadProc must not be NULL for the DLL to be unloadable. If
     * the interpreter is a safe one, pkgPtr->safeUnloadProc must be non-NULL.
     */

    if (Tcl_IsSafe(target)) {
	if (pkgPtr->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 = pkgPtr->safeUnloadProc;
    } else {
	if (pkgPtr->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 = pkgPtr->unloadProc;
    }

    /*
     * We are ready to unload the package. 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(&packageMutex);
	trustedRefCount = pkgPtr->interpRefCount;
	safeRefCount = pkgPtr->safeInterpRefCount;
	Tcl_MutexUnlock(&packageMutex);

	if (Tcl_IsSafe(target)) {
	    safeRefCount--;
	} else {
	    trustedRefCount--;
	}








|







|


|

|
|
|


|

|







|













|
|

|
|
|
|


|


|


|


|
|

|
<
<

|





|

|
|



|





|


|



|
|





|













|
|




|
|

|







|













|
|



|








|

|








|



|










|
|
|
|







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
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
    }

    /*
     * The unload function executed fine. Examine the reference count to see
     * if we unload the DLL.
     */

    Tcl_MutexLock(&packageMutex);
    if (Tcl_IsSafe(target)) {
	pkgPtr->safeInterpRefCount--;

	/*
	 * Do not let counter get negative.
	 */

	if (pkgPtr->safeInterpRefCount < 0) {
	    pkgPtr->safeInterpRefCount = 0;
	}
    } else {
	pkgPtr->interpRefCount--;

	/*
	 * Do not let counter get negative.
	 */

	if (pkgPtr->interpRefCount < 0) {
	    pkgPtr->interpRefCount = 0;
	}
    }
    trustedRefCount = pkgPtr->interpRefCount;
    safeRefCount = pkgPtr->safeInterpRefCount;
    Tcl_MutexUnlock(&packageMutex);

    code = TCL_OK;
    if (pkgPtr->safeInterpRefCount <= 0 && pkgPtr->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 (pkgPtr->fileName[0] != '\0') {
	    Tcl_MutexLock(&packageMutex);
	    if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
		/*
		 * Remove this library from the loaded library cache.
		 */

		defaultPtr = pkgPtr;
		if (defaultPtr == firstPackagePtr) {
		    firstPackagePtr = pkgPtr->nextPtr;
		} else {
		    for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
			    pkgPtr = pkgPtr->nextPtr) {
			if (pkgPtr->nextPtr == defaultPtr) {
			    pkgPtr->nextPtr = defaultPtr->nextPtr;
			    break;
			}
		    }
		}

		/*
		 * Remove this library from the interpreter's library cache.
		 */

		ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
		ipPtr = ipFirstPtr;
		if (ipPtr->pkgPtr == defaultPtr) {
		    ipFirstPtr = ipFirstPtr->nextPtr;
		} else {
		    InterpPackage *ipPrevPtr;

		    for (ipPrevPtr = ipPtr; ipPtr != NULL;
			    ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
			if (ipPtr->pkgPtr == defaultPtr) {
			    ipPrevPtr->nextPtr = ipPtr->nextPtr;
			    break;
			}
		    }
		}
		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
			ipFirstPtr);
		Tcl_Free(defaultPtr->fileName);
		Tcl_Free(defaultPtr->packageName);
		Tcl_Free(defaultPtr);
		Tcl_Free(ipPtr);
		Tcl_MutexUnlock(&packageMutex);
	    } 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(&pkgName);
    Tcl_DStringFree(&tmp);
    if (!complain && (code != TCL_OK)) {
	code = TCL_OK;
	Tcl_ResetResult(interp);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StaticPackage --
 *
 *	This function is invoked to indicate that a particular package has
 *	been linked statically with an application.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Once this function completes, the package becomes loadable via the
 *	"load" command with an empty file name.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_StaticPackage(
    Tcl_Interp *interp,		/* If not NULL, it means that the package has
				 * already been loaded into the given
				 * interpreter by calling the appropriate init
				 * proc. */
    const char *pkgName,	/* Name of package (must be properly
				 * capitalized: first letter upper case,
				 * others lower case). */
    Tcl_PackageInitProc *initProc,
				/* Function to call to incorporate this
				 * package into a trusted interpreter. */
    Tcl_PackageInitProc *safeInitProc)
				/* Function to call to incorporate this
				 * package into a safe interpreter (one that
				 * will execute untrusted scripts). NULL means
				 * the package can't be used in safe
				 * interpreters. */
{
    LoadedPackage *pkgPtr;
    InterpPackage *ipPtr, *ipFirstPtr;

    /*
     * Check to see if someone else has already reported this package as
     * statically loaded in the process.
     */

    Tcl_MutexLock(&packageMutex);
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	if ((pkgPtr->initProc == initProc)
		&& (pkgPtr->safeInitProc == safeInitProc)
		&& (strcmp(pkgPtr->packageName, pkgName) == 0)) {
	    break;
	}
    }
    Tcl_MutexUnlock(&packageMutex);

    /*
     * If the package is not yet recorded as being loaded statically, add it
     * to the list now.
     */

    if (pkgPtr == NULL) {
	pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
	pkgPtr->fileName	= (char *)Tcl_Alloc(1);
	pkgPtr->fileName[0]	= 0;
	pkgPtr->packageName	= (char *)Tcl_Alloc(strlen(pkgName) + 1);
	strcpy(pkgPtr->packageName, pkgName);
	pkgPtr->loadHandle	= NULL;
	pkgPtr->initProc	= initProc;
	pkgPtr->safeInitProc	= safeInitProc;
	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		= firstPackagePtr;
	firstPackagePtr		= pkgPtr;
	Tcl_MutexUnlock(&packageMutex);
    }

    if (interp != NULL) {

	/*
	 * If we're loading the package into an interpreter, determine whether
	 * it's already loaded.
	 */

	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(interp, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
		return;
	    }
	}

	/*
	 * Package isn't loaded in the current interp yet. Mark it as now being
	 * loaded.
	 */

	ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
	ipPtr->pkgPtr = pkgPtr;
	ipPtr->nextPtr = ipFirstPtr;
	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetLoadedPackages, TclGetLoadedPackagesEx --
 *
 *	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 name of the package in that file.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGetLoadedPackages(
    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. */
{
    return TclGetLoadedPackagesEx(interp, targetName, NULL);
}

int
TclGetLoadedPackagesEx(
    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 *packageName)	/* Package name or NULL. If NULL, return info
				 * for all packages.
				 */
{
    Tcl_Interp *target;
    LoadedPackage *pkgPtr;
    InterpPackage *ipPtr;
    Tcl_Obj *resultObj, *pkgDesc[2];

    if (targetName == NULL) {
	TclNewObj(resultObj);
	Tcl_MutexLock(&packageMutex);
	for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
		pkgPtr = pkgPtr->nextPtr) {
	    pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
	    pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewListObj(2, pkgDesc));
	}
	Tcl_MutexUnlock(&packageMutex);
	Tcl_SetObjResult(interp, resultObj);
	return TCL_OK;
    }

    target = Tcl_GetChild(interp, targetName);
    if (target == NULL) {
	return TCL_ERROR;
    }
    ipPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);

    /*
     * Return information about all of the available packages.
     */
    if (packageName) {
	resultObj = NULL;

	for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    pkgPtr = ipPtr->pkgPtr;

	    if (!strcmp(packageName, pkgPtr->packageName)) {
		resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1);
		break;
	    }
	}

	if (resultObj) {
	    Tcl_SetObjResult(interp, resultObj);
	}
	return TCL_OK;
    }

    /*
     * Return information about only the packages that are loaded in a given
     * interpreter.
     */

    TclNewObj(resultObj);
    for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	pkgPtr = ipPtr->pkgPtr;
	pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
	pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -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 InterpPackage 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 InterpPackage functions for interp get deleted.
 *
 *----------------------------------------------------------------------
 */

static void
LoadCleanupProc(
    ClientData clientData,	/* Pointer to first InterpPackage structure
				 * for interp. */
    TCL_UNUSED(Tcl_Interp *))
{
    InterpPackage *ipPtr, *nextPtr;

    ipPtr = (InterpPackage *)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 LoadedPackage structures.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeLoad(void)
{
    LoadedPackage *pkgPtr;

    /*
     * No synchronization here because there should just be one thread alive
     * at this point. Logically, packageMutex 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 (firstPackagePtr != NULL) {
	pkgPtr = firstPackagePtr;
	firstPackagePtr = pkgPtr->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 (pkgPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
	}
#endif

	Tcl_Free(pkgPtr->fileName);
	Tcl_Free(pkgPtr->packageName);
	Tcl_Free(pkgPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|

|





|
|


|





|
|


|
|
|


|













|
|
|




|
|
|

|
|
|
|









|

|


|



|








|


|















|











|

|






|






|
|



|
<
<
|

|
|

|

|


|
|


|



|
|
|
|
|



|


|



|
|
|
|
|
|
|
|
|
|
|
|
|





|



|

|





|



|
|








|









|








|
<
<
<
<
<
<
<
<
<
<
<
<






|
|



|
|




|
|
|
|
|



|








|


|

|



|

|
|











|





|
|
|











|







|






|



|

|













|













|



|




|
|
|









|
|



|
|
|










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
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 (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"







|







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
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
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"dynamic loading is not currently available on this system",
		-1));
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 * 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_Interp *interp,		/* Dummy: unused by this implementation */
    int size)			/* Dummy: unused by this implementation */
{
    return NULL;
}

MODULE_SCOPE int
TclpLoadMemory(
    Tcl_Interp *interp,		/* Used for error reporting. */
    void *buffer,		/* Dummy: unused by this implementation */
    int size,			/* Dummy: unused by this implementation */
    int codeSize,		/* Dummy: unused by this implementation */
    Tcl_LoadHandle *loadHandle,	/* Dummy: unused by this implementation */
    Tcl_FSUnloadFileProc **unloadProcPtr,
				/* Dummy: unused by this implementation */
    int flags)
				/* Dummy: unused by this implementation */
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
		"is not 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
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 (c) 1988-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 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.
 */

/*
 * On Windows, this file needs to be compiled twice, once with UNICODE and










|
|
|







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
67
68
69
70
71
72
73
74
75
76
77
78

/*
 * 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).
 */

#if defined _MSC_VER && _MSC_VER < 1900
/* isatty is always defined on MSVC 14.0, but not necessarily as CRTIMPORT. */
extern CRTIMPORT int	isatty(int fd);
#endif

/*
 * 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,







<
<
<
<
<







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
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
	    is.prompt = PROMPT_START;

	    /*
	     * The final newline is syntactically redundant, and causes some
	     * error messages troubles deeper in, so lop it back off.
	     */

	    (void)TclGetStringFromObj(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)TclGetStringFromObj(resultPtr, &length);
		chan = Tcl_GetStdChannel(TCL_STDOUT);
		if ((length > 0) && chan) {
		    Tcl_WriteObj(chan, resultPtr);
		    Tcl_WriteChars(chan, "\n", 1);
		}
		Tcl_DecrRefCount(resultPtr);
	    }







|
















|







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
780
781
782
783
784
785
786
787
    }
    Tcl_AppendToObj(commandPtr, "\n", 1);
    if (!TclObjCommandComplete(commandPtr)) {
	isPtr->prompt = PROMPT_CONTINUE;
	goto prompt;
    }
    isPtr->prompt = PROMPT_START;
    (void)TclGetStringFromObj(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.







|







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
812
813
814
815
816
817
818
819
	    Tcl_WriteChars(chan, "\n", 1);
	}
    } else if (isPtr->tty) {
	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	chan = Tcl_GetStdChannel(TCL_STDOUT);

	Tcl_IncrRefCount(resultPtr);
	(void)TclGetStringFromObj(resultPtr, &length);
	if ((length > 0) && (chan != NULL)) {
	    Tcl_WriteObj(chan, resultPtr);
	    Tcl_WriteChars(chan, "\n", 1);
	}
	Tcl_DecrRefCount(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
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 (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2002-2005 Donal K. Fellows.
 * Copyright (c) 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]
 *









|
|
|
|
|







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
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 = TclGetStringFromObj(objv[1], &length);
    if (*arg==':' && length > 20
	    && strncmp(arg, "::namespace inscope ", 20) == 0) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    /*







|







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
10
11
12

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
/*
 * 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 (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.

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

#include "tclInt.h"

/*
 * Module-scope struct of notifier hooks that are checked in the default
 * notifier functions (for overriding via Tcl_SetNotifier).
 */

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:
 */









|
|
|
>








|



|







1
2
3
4
5
6
7
8
9
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
177

178
179
180
181
182
183
184
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);







|
>







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
279
280
281
282
283
284
285
286
    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;
}







|







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
797
798
799
800
801
802
803
804
 *	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)







|







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
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 (c) 2005-2012 by Donal K. Fellows
 * Copyright (c) 2017 by 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"





|
|







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

260



261
262
263
264
265
266
267
     * to be fully provided.
     */

    if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) {
	return TCL_ERROR;
    }


    return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,



	    (void *) &tclOOStubs);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetFoundation --







>
|
>
>
>







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
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 (c) 2008-2013 by Donal K. Fellows.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tclOO

######################################################################







|







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
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 (c) 2005-2013 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"






|







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
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 = TclGetStringFromObj(
	    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;
    }







|







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
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 = TclGetStringFromObj(
	    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 = TclGetStringFromObj(
	    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;
    }







|







|







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
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 (c) 2005-2012 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"






|







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
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 (c) 2006-2013 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"






|







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
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 = TclGetStringFromObj(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);








|







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
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 = TclGetStringFromObj(stringObj, &length);
    Namespace *const nsPtr = (Namespace *) namespacePtr;
    FOREACH_HASH_DECLS;
    Tcl_Command cmd, cmd2;

    /*
     * If someone is playing games, we stop playing right now.
     */







|







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
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 = TclGetStringFromObj(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)));







|







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
1553
1554
1555
1556
1557
1558
1559
1560

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    (void)TclGetStringFromObj(objv[2], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, objv[1], objv[2], NULL);







|







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
1759
1760
1761
1762
1763
1764
1765
1766

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    (void)TclGetStringFromObj(objv[1], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, NULL, objv[1], NULL);







|







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
7
8
9
10
11
12
13
14
/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo-related [info]
 *	subcommands.
 *
 * Copyright (c) 2006-2011 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"






|







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
6
7
8
9
10
11
12
13
/*
 * tclOOMethod.c --
 *
 *	This file contains code to create and manage methods.
 *
 * Copyright (c) 2005-2011 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"





|







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
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 = TclGetStringFromObj(infoPtr->variableObj, &varLen);
    if (contextPtr->callPtr->chain[contextPtr->index]
	    .mPtr->declaringClassPtr != NULL) {
	FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
		.mPtr->declaringClassPtr->privateVariables) {
	    match = TclGetStringFromObj(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 = TclGetStringFromObj(variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		cacheIt = 0;
		goto gotMatch;
	    }
	}
    } else {
	FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
	    match = TclGetStringFromObj(privateVar->variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		variableObj = privateVar->fullNameObj;
		cacheIt = 1;
		goto gotMatch;
	    }
	}
	FOREACH(variableObj, contextPtr->oPtr->variables) {
	    match = TclGetStringFromObj(variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		cacheIt = 1;
		goto gotMatch;
	    }
	}
    }
    return NULL;







|




|








|







|







|







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
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 =
	    TclGetStringFromObj(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 = TclGetStringFromObj(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)));
}








|













|







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
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 = TclGetStringFromObj(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







|







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
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 = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" destructor line %d)", kindName,
	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}

/*







|







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
38
39
40
41
42
43
44




45

46
47
48
49
50
51
52

MODULE_SCOPE const char *
TclOOInitializeStubs(
    Tcl_Interp *interp,
    const char *version)
{
    int exact = 0;
    const char *packageName = "TclOO";
    const char *errMsg = NULL;
    TclOOStubs *stubsPtr = NULL;
    const char *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;







|






>
>
>
>
|
>







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
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 (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 * 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.
 */

#include "tclInt.h"
#include "tclTomMath.h"






|
|
|
|
|







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
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)TclGetStringFromObj(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) {







|







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
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
    }
    return objPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringFromObj --
 *
 *	Returns the string representation's byte array pointer and length for
 *	an object.
 *
 * Results:
 *	Returns a pointer to the string representation of objPtr. If lengthPtr
 *	isn't NULL, the length of the string representation is stored at
 *	*lengthPtr. The byte array referenced by the returned pointer must not
 *	be modified by the caller. Furthermore, the caller must copy the bytes
 *	if they need to retain them since the object's string rep can change
 *	as a result of other operations.
 *
 * Side effects:
 *	May call the object's updateStringProc to update the string
 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */


char *
Tcl_GetStringFromObj(
    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) {







|



















>

|







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
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
    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	size_t length;
	const char *str = TclGetStringFromObj(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 = TclGetStringFromObj(objPtr, &length);

    if ((length == 0) || (length > 5)) {
	/*
         * Longest valid boolean string rep. is "false".
         */

	return TCL_ERROR;







|


















|







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
3871
3872

3873
3874
3875
3876
3877
3878
3879

TCL_HASH_TYPE
TclHashObjKey(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    const char *string = TclGetString(objPtr);
    size_t length = 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







<
|
>







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
6
7
8
9
10
11
12
13
/*
 * tclOptimize.c --
 *
 *	This file contains the bytecode optimizer.
 *
 * Copyright (c) 2013 by 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"





|







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
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) TclGetStringFromObj(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) TclGetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;

	case INST_LNOT:







|














|







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
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 (c) 1988-1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if defined(_WIN32) || defined(__CYGWIN__)







|
|
|







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
44
45
46
47
48
49
50
51
52
53
54
55
56
 *
 * Side effects:
 *	Sets the panicProc variable.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{
    panicProc = proc;
    Tcl_InitSubsystems();
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Panic --
 *







|




|







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
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 (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 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"







|
|







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
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;
    Tcl_UniChar unichar = 0;
    int result;
    size_t count;
    char buf[4] = "";

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;







|







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
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 = TclUtfToUniChar(p, &unichar) + 1;	/* +1 for '\' */
	} else {
	    char utfBytes[4];

	    memcpy(utfBytes, p, numBytes - 1);
	    utfBytes[numBytes - 1] = '\0';
	    count = TclUtfToUniChar(utfBytes, &unichar) + 1;
	}
	result = unichar;
	break;
    }

  done:
    if (readPtr != NULL) {







|

|



|







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
2203
2204
2205
2206
2207
2208
2209
2210
		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    size_t clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			(void)TclGetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = (int *)Tcl_Realloc(clPosition,
				maxNumCL * sizeof(int));
		    }







|







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
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 = TclGetStringFromObj(objPtr, &length);

    return CommandComplete(script, length);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|











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
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 (c) 2003 Vince Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclFileSystem.h"







|







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
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)TclGetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		dirSep += 2;
		oldDirSep = dirSep;
		if (dirSep[0] != 0 && dirSep[1] == '.') {
		    goto again;







|







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
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)TclGetStringFromObj(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 */







|







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
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 =
				    TclGetStringFromObj(retVal, &curLen);

			    while (curLen-- > 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

			    /*
			     * We want the trailing slash.
			     */

			    Tcl_SetObjLength(retVal, curLen+1);
			    Tcl_AppendObjToObj(retVal, linkObj);
			    TclDecrRefCount(linkObj);
			    linkStr = TclGetStringFromObj(retVal, &curLen);
			} else {
			    /*
			     * Absolute link.
			     */

			    TclDecrRefCount(retVal);
			    if (Tcl_IsShared(linkObj)) {
				retVal = Tcl_DuplicateObj(linkObj);
				TclDecrRefCount(linkObj);
			    } else {
				retVal = linkObj;
			    }
			    linkStr = TclGetStringFromObj(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 = TclGetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the 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
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 = TclGetStringFromObj(retVal, &len);

	if (len == 2 && path[0] != 0 && path[1] == ':') {
	    if (Tcl_IsShared(retVal)) {
		TclDecrRefCount(retVal);
		retVal = Tcl_DuplicateObj(retVal);
		Tcl_IncrRefCount(retVal);
	    }







|







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
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 = TclGetStringFromObj(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







|







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
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 = TclGetStringFromObj(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







|







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
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 = TclGetStringFromObj(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.
		     */







|







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
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 = TclGetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName,
			length - strlen(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
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 = TclGetStringFromObj(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!
		     */








|







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
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 = TclGetStringFromObj(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.







|







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
1040
1041
1042
1043
1044
1045
1046
1047
	 * We need to perform a more complex operation here.
	 */

    noQuickReturn:
	if (res == NULL) {
	    TclNewObj(res);
	}
	ptr = TclGetStringFromObj(res, &length);

	/*
	 * Strip off any './' before a tilde, unless this is the beginning of
	 * the path.
	 */

	if (length > 0 && strEltLen > 0 && (strElt[0] == '.') &&







|







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
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)TclGetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {







|







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
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 = TclGetStringFromObj(tail, &length);
    if (length == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }
    return copy;
}







|







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
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 = TclGetStringFromObj(cwdPtr, &cwdLen);

    /*
     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
     * Windows special case? Perhaps we should just check if cwd is a root
     * volume.
     */

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	if (tempStr[cwdLen-1] != '/') {
	    cwdLen++;
	}
	break;
    case TCL_PLATFORM_WINDOWS:
	if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') {
	    cwdLen++;
	}
	break;
    }
    tempStr = TclGetStringFromObj(pathPtr, &len);

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}

/*
 *---------------------------------------------------------------------------
 *







|



















|







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
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 = TclGetStringFromObj(transPtr, &len);
	char *result = (char *)Tcl_Alloc(len+1);

	memcpy(result, orig, len+1);
	TclDecrRefCount(transPtr);
	return result;
    }








|







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
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)TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);

	/*
	 * We now own a reference on both 'dir' and 'copy'
	 */

	(void) TclGetStringFromObj(dir, &cwdLen);

	/* 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







|












|







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
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) TclGetStringFromObj(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!
	     */








|







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
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 = TclGetStringFromObj(firstPtr, &firstLen);
    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
    if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) {
	return 1;
    }

    /*
     * Try the most thorough, correct method of comparing fully normalized
     * paths.
     */

    tempErrno = Tcl_GetErrno();
    firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
    secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
    Tcl_SetErrno(tempErrno);

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;
    }

    firstStr = TclGetStringFromObj(firstPtr, &firstLen);
    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
    return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen));
}

/*
 *---------------------------------------------------------------------------
 *
 * SetFsPathFromAny --







|
|


















|
|







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
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 = TclGetStringFromObj(pathPtr, &len);

    /*
     * Handle tilde substitutions, if needed.
     */

    if (len && name[0] == '~') {
	Tcl_DString temp;







|







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
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 = TclGetStringFromObj(copy, &cwdLen);
    pathPtr->length = cwdLen;
    TclInitStringRep(copy, NULL, 0);
    TclDecrRefCount(copy);
}

/*
 *---------------------------------------------------------------------------







|







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
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) TclGetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */

	    return -1;
	}







|







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
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 (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|







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
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 (c) 1996 Sun Microsystems, Inc.
 * Copyright (c) 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.






|
|







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
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 = TclGetStringFromObj(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;







|







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
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 = TclGetStringFromObj(iPtr->scriptFile, &length);
	    DupBlock(availPtr->pkgIndex, argv4, length + 1);
	}
	argv4 = TclGetStringFromObj(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;







|


|







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
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 = TclGetStringFromObj(objv[2], &length);
	    if (argv2[0] == 0) {
		iPtr->packageUnknown = NULL;
	    } else {
		DupBlock(iPtr->packageUnknown, argv2, length+1);
	    }
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, "?command?");







|







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
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 = TclGetStringFromObj(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);
	}







|







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
5
6
7
8
9
10
11
12
13
14
/*
 * tclPkgConfig.c --
 *
 *	This file contains the configuration information to embed into the tcl
 *	binary library.
 *
 * Copyright (c) 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:




|

|







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
113

114
115
116
117
118
119
120
    /* 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},
    {"zipfile,runtime",		CFG_RUNTIME_ZIPFILE},


    /* 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},







>

<
>







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
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
#   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:
 */

#ifdef MAC_OSX_TCL /* MACOSX */
/* 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);
#endif /* MACOSX */





typedef struct TclPlatStubs {
    int magic;
    void *hooks;

#ifdef MAC_OSX_TCL /* MACOSX */
    void (*reserved0)(void);
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */

#endif /* MACOSX */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#ifdef MAC_OSX_TCL /* MACOSX */
/* Slot 0 is reserved */
#define Tcl_MacOSXOpenVersionedBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */



#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */




#ifdef MAC_OSX_TCL /* MACOSX */


#undef Tcl_MacOSXOpenBundleResources
#define Tcl_MacOSXOpenBundleResources(a,b,c,d,e) Tcl_MacOSXOpenVersionedBundleResources(a,b,NULL,c,d,e)
#endif


#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT


#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 */







>
>
>
>
>
>
>
>











<







|
>
>
>
>





<


>
|














<



>
>
>
|





>
>
>
|
>
>
|
<

|
>
|
<
>









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
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 (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|
|







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
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 (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 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"








|
|







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
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 (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004-2006 Miguel Sofer
 * 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.
 */

#include "tclInt.h"
#include "tclCompile.h"






|
|
|
|







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
355
356
357
358
359
360
361
362
	    procArgs++;
	}

	/*
	 * The argument list is just "args"; check the body
	 */

	procBody = TclGetStringFromObj(objv[3], &numBytes);
	if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
	    goto done;
	}

	/*
	 * The body is just spaces: link the compileProc
	 */







|







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
450
451
452
453
454
455
456
457
	 */

	if (Tcl_IsShared(bodyPtr)) {
	    const char *bytes;
	    size_t length;
	    Tcl_Obj *sharedBodyPtr = bodyPtr;

	    bytes = TclGetStringFromObj(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.
	     */







|







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
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 = TclGetStringFromObj(fieldValues[0], &nameLength);

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	argnamei = argname;
	argnamelast = (nameLength > 0) ? (argname + nameLength - 1) : argname;







|







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
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 = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength);
		const char *value = TclGetStringFromObj(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]);







|
|







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
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 = TclGetStringFromObj(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)));
}







|







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
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 = TclGetStringFromObj(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)));
}







|







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
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 (c) 2017 Frederic Bonnet.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|







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
7
8
9
10
11
12
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 (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#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 (c) 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






|
|




















|







1
2
3
4
5
6
7
8
9
10
11
12
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
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 = TclGetUnicodeFromObj(textObj, &length);

    if (offset > length) {
	offset = length;
    }
    udata += offset;
    length -= offset;








|







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
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 = TclGetStringFromObj(objPtr, &length);

	regexpPtr = CompileRegexp(interp, pattern, length, flags);
	if (regexpPtr == NULL) {
	    return NULL;
	}

	RegexpSetIntRep(objPtr, regexpPtr);







|







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
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 (c) 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"









|







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
6
7
8
9
10
11
12
13
/*
 * tclResult.c --
 *
 *	This file contains code to manage the interpreter result.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"






|







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
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 = TclGetStringFromObj(iPtr->objResultPtr, &length);
    if (TclNeedSpace(bytes, bytes + length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
    }
    Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
    Tcl_DecrRefCount(listPtr);
}








|







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
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) TclGetStringFromObj(valuePtr, &length);
	    if (length) {
		iPtr->errorInfo = valuePtr;
		Tcl_IncrRefCount(iPtr->errorInfo);
		iPtr->flags |= ERR_ALREADY_LOGGED;
	    }
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],







|







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
6
7
8
9
10
11
12
13
/*
 * tclScan.c --
 *
 *	This file contains the implementation of the "scan" command.
 *
 * Copyright (c) 1998 by 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"





|







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
10
11
12
13
14
15
16
17
18
19
20
21
22
23





24
25
26
27
28
29
30
/*
 * 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 (c) 2005 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"
#include <float.h>
#include <math.h>

#ifdef _WIN32
#define copysign _copysign
#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.
 */










|













>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
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
540
541
542
543
544
545
546
547
    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	((Tcl_WideUInt)-1)
#define MOST_BITS	(ALL_BITS >> 1)

    /*
     * Initialize bytes to start of the object's string rep if the caller
     * didn't pass anything else.
     */








|







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
723
724
725
726
727
728
729
730
			 * too large shifts first.
			 */

			if ((octalSignificandWide != 0)
				&& (((size_t)shift >=
					CHAR_BIT*sizeof(Tcl_WideUInt))
				|| (octalSignificandWide >
					((Tcl_WideUInt)-1 >> shift)))) {
			    octalSignificandOverflow = 1;
			    err = mp_init_u64(&octalSignificandBig,
				    octalSignificandWide);
			}
		    }
		    if (!octalSignificandOverflow) {
			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
807
808
809
810
811
812
813
814
		     * 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 > ((Tcl_WideUInt)-1 >> shift))) {
			significandOverflow = 1;
			err = mp_init_u64(&significandBig,
				significandWide);
		    }
		}
		if (!significandOverflow) {
		    significandWide = (significandWide << shift) + d;







|







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
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
	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;


	    }
	    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 > ((Tcl_WideUInt)-1 >> shift))) {
			significandOverflow = 1;
			err = mp_init_u64(&significandBig,
				significandWide);
		    }
		}
		if (!significandOverflow) {
		    significandWide = (significandWide << shift) + 1;







|
|
|
|


>
>












|







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
886
887
888
889
890
891
892
893
894
895
896
897
	    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 */








|
|
|
|
|







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
1533
1534
1535
1536
1537
1538
1539
1540
	    /*
	     * There's no need to multiply if the multiplicand is zero.
	     */

	    *wideRepPtr = digit;
	    return 0;
	} else if (numZeros >= maxpow10_wide
		|| w > ((Tcl_WideUInt)-1-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;







|







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
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

    if (k_check && d < 1. && ilim > 0) {
	if (ilim1 < 0) {
	    return NULL;
	}
	ilim = ilim1;
	--k;
	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 -= 5.;
	if (d > eps.d) {
	    *retval = '1';
	    *decpt = k;
	    return retval;
	} else if (d < -eps.d) {
	    *decpt = k;
	    return retval;







|
















|







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
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
{
#ifndef IEEE_FLOATING_POINT
    strcpy(buffer, "NaN");
    return;
#else
    union {
	double dv;
	Tcl_WideUInt iv;
    } bitwhack;

    bitwhack.dv = value;
    if (n770_fp) {
	bitwhack.iv = Nokia770Twiddle(bitwhack.iv);
    }
    if (bitwhack.iv & ((Tcl_WideUInt) 1 << 63)) {
	bitwhack.iv &= ~ ((Tcl_WideUInt) 1 << 63);
	*buffer++ = '-';
    }
    *buffer++ = 'N';
    *buffer++ = 'a';
    *buffer++ = 'N';
    bitwhack.iv &= (((Tcl_WideUInt) 1) << 51) - 1;
    if (bitwhack.iv != 0) {
	sprintf(buffer, "(%" TCL_LL_MODIFIER "x)", bitwhack.iv);
    } else {
	*buffer = '\0';
    }
#endif /* IEEE_FLOATING_POINT */
}

/*







|






|
|





|

|







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
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 (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"







|
|







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
421
422
423
424
425
426
427
428
     * 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) TclGetByteArrayFromObj(objPtr, &numChars);
	return numChars;
    }

    /*
     * OK, need to work with the object as a string.
     */








|







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
520
521
522
523
524
525
526
527
    /*
     * 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 = TclGetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return bytes[index];
    }








|







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
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
#endif
    return ch;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj --
 *
 *	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.
 *
 *----------------------------------------------------------------------
 */


























Tcl_UniChar *
Tcl_GetUnicodeFromObj(
    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);







|














>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|







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
658
659
660
661
662
663
664
665

    /*
     * 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 = TclGetByteArrayFromObj(objPtr, &length);

	if (last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    return Tcl_NewObj();
	}







|







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
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
	toCopy = length;
    } else {
	if (ellipsis == NULL) {
	    ellipsis = "...";
	}
	eLen = strlen(ellipsis);
	while (eLen > limit) {
	    eLen = TclUtfPrev(ellipsis+eLen, ellipsis) - ellipsis;
	}

	toCopy = TclUtfPrev(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 (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= 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
1165
1166
1167
1168
1169
1170
1171
1172

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 -1, then append all bytes up to NUL
				 * byte. */
{
    Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_INDEX_NONE, NULL);
}

/*
 *----------------------------------------------------------------------







|







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
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
	 * cases.
	 *
	 * First, get the lengths.
	 */

	size_t lengthSrc = 0;

	(void) TclGetByteArrayFromObj(objPtr, &length);
	(void) TclGetByteArrayFromObj(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,
		Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
	return;
    }

    /*
     * Must append as strings.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);








    /*
     * If objPtr has a valid Unicode rep, then get a Unicode string from
     * appendObjPtr and append it.
     */

    if (stringPtr->hasUnicode) {
	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (TclHasIntRep(appendObjPtr, &tclStringType)) {
	    Tcl_UniChar *unicode =
		    TclGetUnicodeFromObj(appendObjPtr, &numChars);

	    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
	} else {
	    bytes = TclGetStringFromObj(appendObjPtr, &length);
	    AppendUtfToUnicodeRep(objPtr, bytes, length);
	}
	return;
    }

    /*
     * Append to objPtr's UTF string rep. If we know the number of characters
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = TclGetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars != TCL_INDEX_NONE) && TclHasIntRep(appendObjPtr, &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }







|
|



















|










>
>
>
>
>
>
>












|



|











|







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
1693
1694
1695
1696
1697
1698
1699
1700
	"\"%n$\" argument index out of range"
    };
    static const char *overflow = "max size for a Tcl value exceeded";

    if (Tcl_IsShared(appendObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
    }
    (void)TclGetStringFromObj(appendObj, &originalLength);
    limit = (size_t)INT_MAX - originalLength;

    /*
     * Format string is NUL-terminated.
     */

    while (*format != '\0') {







|







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
2087
2088
2089
2090
2091
2092
2093
2094
#endif
		} else if (useBig) {
		    pure = Tcl_NewBignumObj(&big);
		} else {
		    TclNewIntObj(pure, l);
		}
		Tcl_IncrRefCount(pure);
		bytes = TclGetStringFromObj(pure, &length);

		/*
		 * Already did the sign above.
		 */

		if (*bytes == '-') {
		    length--;







|







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
2371
2372
2373
2374
2375
2376
2377
2378
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	(void)TclGetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;







|







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
2515
2516
2517
2518
2519
2520
2521
2522

		/*
		 * 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 = TclUtfPrev(end, bytes);
		if (!Tcl_UtfCharComplete(q, (end - q))) {
		    end = q;
		}

		q = bytes + 4;
		while ((bytes < end) && (bytes < q)
			&& ((*bytes & 0xC0) == 0x80)) {







|







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
2723
2724
2725
2726
2727
2728
2729
2730
TclGetStringStorage(
    Tcl_Obj *objPtr,
    size_t *sizePtr)
{
    String *stringPtr;

    if (!TclHasIntRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
	return TclGetStringFromObj(objPtr, sizePtr);
    }

    stringPtr = GET_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}








|







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
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
		unichar = 1;
	    }
	}
    }

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
	(void)TclGetByteArrayFromObj(objPtr, &length);
    } else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	(void)TclGetUnicodeFromObj(objPtr, &length);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	(void)TclGetStringFromObj(objPtr, &length);
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	return objPtr;
    }








|


|


|







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
2815
2816
2817
2818
2819
2820
2821
2822
	Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */
	Tcl_SetByteArrayLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	TclAppendBytesToByteArray(objResultPtr,
		Tcl_GetByteArrayFromObj(objResultPtr, NULL),
		(count - done) * length);
    } else if (unichar) {
	/*
	 * Efficiently produce a pure Tcl_UniChar array result.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {







|







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
2904
2905
2906
2907
2908
2909
2910
2911
    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;
    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) {







|







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


2940
2941
2942
2943
2944
2945
2946
2947
	    if (objPtr->length) {
		/*
		 * Non-empty string rep. Not a pure bytearray, so we won't
		 * create a pure bytearray.
		 */

	 	binary = 0;


		if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
		    /* Prevent shimmer of non-string types. */
		    allowUniChar = 0;
		}
	    }
	} else {
	    /* assert (objPtr->typePtr != NULL) -- stork! */
	    binary = 0;







>
>
|







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
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
	    /*
	     * 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)TclGetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */

		if (numBytes) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    }
		    length += numBytes;
		}
	    }
	} while (--oc);
    } else if (allowUniChar && requestUniChar) {
	/*
	 * 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)TclGetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
		if (numChars) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    }
		    length += numChars;
		}







|










|












|







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
3031
3032
3033
3034
3035
3036
3037
3038

		Tcl_Obj *objPtr = *ov++;

		if (objPtr->bytes == NULL) {
		    /* No string rep; Take the chance we can avoid making it */
		    pendingPtr = objPtr;
		} else {
		    (void)TclGetStringFromObj(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,







|







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
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
		 * There's a pending value followed by more values.  Loop over
		 * remaining values generating strings until a non-empty value
		 * is found, or the pending value gets its string generated.
		 */

		do {
		    Tcl_Obj *objPtr = *ov++;
		    (void)TclGetStringFromObj(objPtr, &numBytes); /* PANIC? */
		} while (--oc && numBytes == 0 && pendingPtr->bytes == NULL);

		if (numBytes) {
		    last = objc -oc -1;
		}
		if (oc || numBytes) {
		    (void)TclGetStringFromObj(pendingPtr, &length);
		}
		if (length == 0) {
		    if (numBytes) {
			first = last;
		    }
		} else if (numBytes + length > (size_t)INT_MAX) {
		    goto overflow;







|






|







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
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
	 * failure to allocate enough space. Following stanza may panic.
	 */

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start = 0;

	    objResultPtr = *objv++; objc--;
	    (void)TclGetByteArrayFromObj(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 = TclGetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, more);
		dst += more;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	Tcl_UniChar *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start;

	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    (void)TclGetUnicodeFromObj(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)));







|
















|




|









|







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
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t more;
		Tcl_UniChar *src = TclGetUnicodeFromObj(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)TclGetStringFromObj(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);
		}







|













|







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
3232
3233
3234
3235
3236
3237
3238
3239
	    dst = TclGetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t more;
		char *src = TclGetStringFromObj(objPtr, &more);

		memcpy(dst, src, more);
		dst += more;
	    }
	}
	/* Must NUL-terminate! */
	*dst = '\0';







|







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
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
	    /*
	     * 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 *) TclGetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) TclGetByteArrayFromObj(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 *) TclGetUnicodeFromObj(value1Ptr, &s1len);
		s2 = (char *) TclGetUnicodeFromObj(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 (
#ifdef WORDS_BIGENDIAN
			    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 = TclGetStringFromObj(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 = TclGetStringFromObj(value1Ptr, &s1len);
		    break;
		case 0:
		    match = 1;
		    goto matchdone;
		case 1:
		default: /* avoid warn: `s1` may be used uninitialized */
		    match = 0;
		    goto matchdone;
		}
	    } else {
		s1 = TclGetStringFromObj(value1Ptr, &s1len);
		s2 = TclGetStringFromObj(value2Ptr, &s2len);
	    }
	    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.
		 */







|
|











|
|















|




















|














|










|
|







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
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
	 * 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 = TclGetByteArrayFromObj(needle, &ln);

	/* Find bytes in bytes */
	bh = TclGetByteArrayFromObj(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;







|


|







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
3522
3523
3524
3525
3526
3527
3528
3529
3530
     * 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 = TclGetUnicodeFromObj(needle, &ln);
    uh = TclGetUnicodeFromObj(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++) {







|
|







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
3582
3583
3584
3585
3586
3587
3588
3589
3590
	 * 	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 = TclGetByteArrayFromObj(haystack, &lh);
	unsigned char *bn = TclGetByteArrayFromObj(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;







|
|







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
3605
3606
3607
3608
3609
3610
3611
3612
3613
		goto lastEnd;
	    }
	    check--;
	}
	goto lastEnd;
    }

    uh = TclGetUnicodeFromObj(haystack, &lh);
    un = TclGetUnicodeFromObj(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;







|
|







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
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
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;
	unsigned char *from = TclGetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
	return objPtr;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode) {
	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);

	Tcl_UniChar *src = from + stringPtr->numChars;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    Tcl_UniChar *to;


	    /*
	     * Create a non-empty, pure unicode value, so we can coax
	     * Tcl_SetObjLength into growing the unicode rep buffer.
	     */

	    objPtr = Tcl_NewUnicodeObj(&ch, 1);
	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
	    to = Tcl_GetUnicode(objPtr);

	    while (--src >= from) {







		*to++ = *src;

	    }
	} else {
	    /*
	     * Reversing in place.
	     */




	    while (--src > from) {
		ch = *src;





		*src = *from;
		*from++ = ch;
	    }
	}



















    }

    if (objPtr->bytes) {
	size_t numChars = stringPtr->numChars;
	size_t numBytes = objPtr->length;
	char *to, *from = objPtr->bytes;








>
>
>



|




|








>

<
<
|

>








>

>
>
>
>
>
>
>

>






>
>
>


>
>
>
>
>




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
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
	     * 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 charCount = 0;
	    size_t bytesLeft = numBytes;


	    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 = TclUtfToUniChar(from, &ch);

		ReverseBytes((unsigned char *)to, (unsigned char *)from,
			bytesInChar);
		to += bytesInChar;
		from += bytesInChar;
		bytesLeft -= bytesInChar;
		charCount++;
	    }

	    from = to = objPtr->bytes;
	    stringPtr->numChars = charCount;
	}
	/* Pass 2. Reverse all the bytes. */
	ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
    }

    return objPtr;
}







<

>








|






<



<







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
3832
3833
3834
3835
3836
3837
3838
3839
     * 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 = TclGetByteArrayFromObj(objPtr, &numBytes);

	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;
	    assert ( first + count <= numBytes ) ;







|







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
3856
3857
3858
3859
3860
3861
3862
3863
	if ((first == 0) && (count == numBytes)) {
	    return insertPtr;
	}

	if (TclIsPureByteArray(insertPtr)) {
	    size_t newBytes = 0;
	    unsigned char *iBytes
		    = TclGetByteArrayFromObj(insertPtr, &newBytes);

	    if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) {
		/*
		 * Removal count and replacement count are equal.
		 * Other conditions permit. Do in-place splice.
		 */








|







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
3900
3901
3902
3903
3904
3905
3906
3907
     * 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 = TclGetUnicodeFromObj(objPtr, &numChars);

	/* TODO: Is there an in-place option worth pursuing here? */

	result = Tcl_NewUnicodeObj(ustring, first);
	if (insertPtr) {
	    Tcl_AppendObjToObj(result, insertPtr);
	}







|







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
3975

3976








3977




3978
3979
3980
3981
3982
3983
3984

    stringPtr->hasUnicode = 1;
    if (bytes) {
	stringPtr->numChars = needed;
    } else {
	numAppendChars = 0;
    }
    for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {

	bytes += TclUtfToUniChar(bytes, &unichar);








	*dst = unichar;




    }
    *dst = 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
6
7
8
9
10
11
12
13
/*
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath_private.h"





|







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
63
64
65
66
67
68






69
70
71
72
73
74
75
76
77
78





79
80
81
82
83
84
85
#undef Tcl_SetIntObj
#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
#undef TclWinSetSockOpt
#undef TclWinNToHS
#undef TclStaticPackage
#undef Tcl_BackgroundError
#define TclStaticPackage Tcl_StaticPackage
#undef Tcl_UniCharToUtfDString
#undef Tcl_UtfToUniCharDString
#undef Tcl_UtfToUniChar







#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 *, int *))(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 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







|

|



>
>
>
>
>
>






|



>
>
>
>
>







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
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
#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_reverse mp_reverse
#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_xor mp_xor
#define TclBN_mp_zero mp_zero
#define TclBN_s_mp_add s_mp_add
#define TclBN_s_mp_balance_mul 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 TclUnixWaitForFile_ TclUnixWaitForFile

#ifndef MAC_OSX_TCL /* On UNIX, fill with other stub entries */
#define TclMacOSXGetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj **))(void *)TclpCreateProcess
#define TclMacOSXSetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj *))(void *)isatty
#define TclMacOSXCopyFileAttributes (int (*)(const char *, const char *, const Tcl_StatBuf *))(void *)TclUnixCopyFile
#define TclMacOSXMatchType (int (*)(Tcl_Interp *, const char *, const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))(void *)TclpMakeFile

#define TclMacOSXNotifierAddRunLoopMode (void (*)(const void *))(void *)TclpOpenFile








#endif

#ifdef _WIN32
#   define TclUnixWaitForFile 0
#   define TclUnixCopyFile 0
#   define TclUnixOpenTemporaryFile 0
#   define TclpReaddir 0

#   define TclpIsAtty 0
#elif defined(__CYGWIN__)
#   define TclpIsAtty isatty
static void
doNothing(void)
{
    /* dummy implementation, no need to do anything */







<













>



|












>
>
>
|
>

|
|
<
<
>
|
>
>
>
>
>
>
>
>







>







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
249






250
251
252
253
254
255
256
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 */

#endif /* __CYGWIN__ */







/*
 * 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.
 */








|
>
>
>
>
>
>







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
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
    0, /* 30 */
    TclGetExtension, /* 31 */
    TclGetFrame, /* 32 */
    0, /* 33 */
    0, /* 34 */
    0, /* 35 */
    0, /* 36 */
    TclGetLoadedPackages, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
    TclpGetUserHome, /* 42 */
    0, /* 43 */
    TclGuessPackageName, /* 44 */
    TclHideUnsafeCommands, /* 45 */
    TclInExit, /* 46 */
    0, /* 47 */
    0, /* 48 */
    0, /* 49 */
    0, /* 50 */
    TclInterpInit, /* 51 */







|






|







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
375
376
377
378
379
380
381
382
    0, /* 94 */
    0, /* 95 */
    TclRenameCommand, /* 96 */
    TclResetShadowedCmdRefs, /* 97 */
    TclServiceIdle, /* 98 */
    0, /* 99 */
    0, /* 100 */
    TclSetPreInitScript, /* 101 */
    TclSetupEnv, /* 102 */
    TclSockGetPort, /* 103 */
    0, /* 104 */
    0, /* 105 */
    0, /* 106 */
    0, /* 107 */
    TclTeardownNamespace, /* 108 */







|







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
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
    TclPtrMakeUpvar, /* 229 */
    TclObjLookupVar, /* 230 */
    TclGetNamespaceFromObj, /* 231 */
    TclEvalObjEx, /* 232 */
    TclGetSrcInfoForPc, /* 233 */
    TclVarHashCreateVar, /* 234 */
    TclInitVarHashTable, /* 235 */
    0, /* 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 */
    TclStaticPackage, /* 257 */
    TclpCreateTemporaryDirectory, /* 258 */
    TclAppendUnicodeToObj, /* 259 */
    TclGetBytesFromObj, /* 260 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclGetAndDetachPids, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    TclUnixWaitForFile_, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    0, /* 10 */
    0, /* 11 */
    0, /* 12 */
    0, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    0, /* 20 */
    0, /* 21 */
    TclpCreateTempFile_, /* 22 */
    0, /* 23 */
    0, /* 24 */
    0, /* 25 */
    0, /* 26 */
    0, /* 27 */
    0, /* 28 */
    TclWinCPUID, /* 29 */
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    TclWinConvertError, /* 0 */
    0, /* 1 */
    0, /* 2 */
    0, /* 3 */
    TclWinGetTclInstance, /* 4 */
    TclUnixWaitForFile, /* 5 */
    0, /* 6 */
    0, /* 7 */
    TclpGetPid, /* 8 */
    0, /* 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 */
    TclGetAndDetachPids, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    TclUnixWaitForFile_, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    0, /* 10 */
    0, /* 11 */
    0, /* 12 */
    0, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    0, /* 20 */
    0, /* 21 */
    TclpCreateTempFile_, /* 22 */
    0, /* 23 */
    0, /* 24 */
    0, /* 25 */
    0, /* 26 */
    0, /* 27 */
    0, /* 28 */
    TclWinCPUID, /* 29 */
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* MACOSX */
};

static const TclPlatStubs tclPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#ifdef MAC_OSX_TCL /* MACOSX */
    0, /* 0 */
    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */

#endif /* MACOSX */
};

const TclTomMathStubs tclTomMathStubs = {
    TCL_STUB_MAGIC,
    0,
    TclBN_epoch, /* 0 */
    TclBN_revision, /* 1 */







|




















|

<
|






|



|
|


|


|


|
|
|
|
|

|



|


|





|
|
|
|


|
|

|


|
|
|



|
|


|










|



|
|


|


|


|
|
|
|
|

|



|


|









<


>
|







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
724
725
726
727
728
729
730
731
    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 */
    0, /* 71 */
    0, /* 72 */
    0, /* 73 */
    0, /* 74 */
    0, /* 75 */
    TclBN_mp_signed_rsh, /* 76 */
    0, /* 77 */
    TclBN_mp_to_ubin, /* 78 */







|







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
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
    Tcl_Panic, /* 2 */
    Tcl_Alloc, /* 3 */
    Tcl_Free, /* 4 */
    Tcl_Realloc, /* 5 */
    Tcl_DbCkalloc, /* 6 */
    Tcl_DbCkfree, /* 7 */
    Tcl_DbCkrealloc, /* 8 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    Tcl_CreateFileHandler, /* 9 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    0, /* 9 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_CreateFileHandler, /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    Tcl_DeleteFileHandler, /* 10 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    0, /* 10 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_DeleteFileHandler, /* 10 */
#endif /* MACOSX */
    Tcl_SetTimer, /* 11 */
    Tcl_Sleep, /* 12 */
    Tcl_WaitForEvent, /* 13 */
    Tcl_AppendAllObjTypes, /* 14 */
    Tcl_AppendStringsToObj, /* 15 */
    Tcl_AppendToObj, /* 16 */
    Tcl_ConcatObj, /* 17 */







<

<
<
<
<
<
<
<
<

<
<
<
<
<
<
<







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
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
    0, /* 26 */
    Tcl_DbNewObj, /* 27 */
    Tcl_DbNewStringObj, /* 28 */
    Tcl_DuplicateObj, /* 29 */
    TclFreeObj, /* 30 */
    Tcl_GetBoolean, /* 31 */
    Tcl_GetBooleanFromObj, /* 32 */
    Tcl_GetByteArrayFromObj, /* 33 */
    Tcl_GetDouble, /* 34 */
    Tcl_GetDoubleFromObj, /* 35 */
    0, /* 36 */
    Tcl_GetInt, /* 37 */
    Tcl_GetIntFromObj, /* 38 */
    Tcl_GetLongFromObj, /* 39 */
    Tcl_GetObjType, /* 40 */
    Tcl_GetStringFromObj, /* 41 */
    Tcl_InvalidateStringRep, /* 42 */
    Tcl_ListObjAppendList, /* 43 */
    Tcl_ListObjAppendElement, /* 44 */
    Tcl_ListObjGetElements, /* 45 */
    Tcl_ListObjIndex, /* 46 */
    Tcl_ListObjLength, /* 47 */
    Tcl_ListObjReplace, /* 48 */







|







|







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
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
    Tcl_GetCommandName, /* 160 */
    Tcl_GetErrno, /* 161 */
    Tcl_GetHostName, /* 162 */
    Tcl_GetInterpPath, /* 163 */
    Tcl_GetParent, /* 164 */
    Tcl_GetNameOfExecutable, /* 165 */
    Tcl_GetObjResult, /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    Tcl_GetOpenFile, /* 167 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    0, /* 167 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_GetOpenFile, /* 167 */
#endif /* MACOSX */
    Tcl_GetPathType, /* 168 */
    Tcl_Gets, /* 169 */
    Tcl_GetsObj, /* 170 */
    Tcl_GetServiceMode, /* 171 */
    Tcl_GetChild, /* 172 */
    Tcl_GetStdChannel, /* 173 */
    0, /* 174 */







<

<
<
<
<
<
<
<







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
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
    Tcl_ThreadQueueEvent, /* 319 */
    Tcl_UniCharAtIndex, /* 320 */
    Tcl_UniCharToLower, /* 321 */
    Tcl_UniCharToTitle, /* 322 */
    Tcl_UniCharToUpper, /* 323 */
    Tcl_UniCharToUtf, /* 324 */
    Tcl_UtfAtIndex, /* 325 */
    Tcl_UtfCharComplete, /* 326 */
    Tcl_UtfBackslash, /* 327 */
    Tcl_UtfFindFirst, /* 328 */
    Tcl_UtfFindLast, /* 329 */
    Tcl_UtfNext, /* 330 */
    Tcl_UtfPrev, /* 331 */
    Tcl_UtfToExternal, /* 332 */
    Tcl_UtfToExternalDString, /* 333 */
    Tcl_UtfToLower, /* 334 */
    Tcl_UtfToTitle, /* 335 */
    Tcl_UtfToChar16, /* 336 */
    Tcl_UtfToUpper, /* 337 */
    Tcl_WriteChars, /* 338 */







|



|
|







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
1203
1204
1205
1206
1207
1208
1209
1210
    Tcl_UntraceCommand, /* 427 */
    Tcl_AttemptAlloc, /* 428 */
    Tcl_AttemptDbCkalloc, /* 429 */
    Tcl_AttemptRealloc, /* 430 */
    Tcl_AttemptDbCkrealloc, /* 431 */
    Tcl_AttemptSetObjLength, /* 432 */
    Tcl_GetChannelThread, /* 433 */
    Tcl_GetUnicodeFromObj, /* 434 */
    0, /* 435 */
    0, /* 436 */
    Tcl_SubstObj, /* 437 */
    Tcl_DetachChannel, /* 438 */
    Tcl_IsStandardChannel, /* 439 */
    Tcl_FSCopyFile, /* 440 */
    Tcl_FSCopyDirectory, /* 441 */







|







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
7
8
9
10
11
12
13
14
15
16
17
18
19

20
21
22
23
24

25
26
27
28
29
30
31
/*
 * tclStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 *
 * Copyright (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 const TclStubs *tclStubsPtr;
MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;


const TclStubs *tclStubsPtr = NULL;
const TclPlatStubs *tclPlatStubsPtr = NULL;
const TclIntStubs *tclIntStubsPtr = NULL;
const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;


/*
 * Use our own ISDIGIT to avoid linking to libc on windows
 */

#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)







|
|











>





>







1
2
3
4
5
6
7
8
9
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
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
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;


    /*
     * 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, "Tcl", 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, "Tcl", version, 1, NULL);
		return NULL;
	    }
	} else {
	    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
	    if (actualVersion == NULL) {
		return NULL;
	    }
	}
    }
    if (((exact&0xFF00) < 0x900)) {
	/* We are running Tcl 8.x */
	stubsPtr = (TclStubs *)pkgData;



    }
    tclStubsPtr = stubsPtr;

    if (stubsPtr->hooks) {
	tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs;
	tclIntStubsPtr = stubsPtr->hooks->tclIntStubs;
	tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs;







|



>













|



















|



|








>
>
>







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
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 (c) 1993-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#ifndef USE_TCL_STUBS








|
|
|
|







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
277
278
279
280
281
282
283
284
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;
static Tcl_CmdProc	TeststaticpkgCmd;
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;







>












|







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
463
464
465
466
467
468
469
470
    }
#endif
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Create additional commands and math functions for testing Tcl.
     */








|







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
604
605
606
607
608
609
610
611
	    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, "teststaticpkg", TeststaticpkgCmd,
	    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,







|







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
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
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TeststaticpkgCmd --
 *
 *	This procedure implements the "teststaticpkg" command.
 *	It is used to test the procedure Tcl_StaticPackage.
 *
 * 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
TeststaticpkgCmd(
    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], " pkgName 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_StaticPackage((loaded) ? interp : NULL, argv[1],
	    StaticInitProc, (safe) ? StaticInitProc : NULL);
    return TCL_OK;
}

static int
StaticInitProc(
    Tcl_Interp *interp)		/* Interpreter in which package is supposedly







|

|
|












|









|








|







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
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
    }
    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, "TclGetStringFromObj 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 TclGetStringFromObj 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) {







|







|







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


6917
6918
6919
6920
6921
6922
6923
6924
6925
	}
    }
    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) {


	    first = buffer;
	    break;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewIntObj(first - buffer - 1));

    return TCL_OK;
}







>
>
|
|







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
6964
6965
6966
6967
6968
6969
6970
6971
	}
	if (offset > numBytes) {
	    offset = numBytes;
	}
    } else {
	offset = numBytes;
    }
    result = TclUtfPrev(bytes + offset, bytes);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result - bytes));
    return TCL_OK;
}

/*
 * Used to check correct string-length determining in Tcl_NumUtfChars
 */







|







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
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 (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS








|
|
|







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
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
	     * 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], &length);
	    if ((varPtr[varIndex] != NULL)
		    && !Tcl_IsShared(varPtr[varIndex])) {
		Tcl_SetStringObj(varPtr[varIndex], string, length);
	    } else {
		SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length));
	    }
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 7:				/* set2 */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }







|


|

|







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
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
	     * "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], &length);

	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((i < 0) || (i > length)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"index value out of range", -1));
		return TCL_ERROR;
	    }

	    Tcl_AppendToObj(varPtr[varIndex], string + i, length - 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], &length);

	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((i < 0) || (i > length)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"index value out of range", -1));
		return TCL_ERROR;
	    }

	    TclAppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
    }

    return TCL_OK;
}








|




|





|



















|




|





|







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
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 (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

/*
 * name and version of this package
 */

static const char packageName[] = "procbodytest";
static const char packageVersion[] = "1.1";

/*
 * Name of the commands exported by this package
 */

static const char procCommand[] = "proc";







|














|







1
2
3
4
5
6
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
78
79
80
81
82
83
84
85
};

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_Init --
 *
 *	This function initializes the "procbodytest" package.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *







|







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
102
103
104
105
106
107
108
109
}

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_SafeInit --
 *
 *	This function initializes the "procbodytest" package.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *







|







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
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 procbodytest package
 *  was provided.  Places a boolean in the interp result indicating the
 *  test outcome.
 *
 * Results:
 *  Returns a standard Tcl code.
 *
 *----------------------------------------------------------------------







|







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
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 (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 2008 by 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"







|
|







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
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 (C) 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)








|







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
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
    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 numWaits;		/* Number of waits to acquire a lock */
    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 */
    int numObjects;		/* Number of objects for thread */
    Tcl_Obj *lastPtr;		/* Last object in this cache */
    int 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.
 */







<

|













|

|







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
135
136
137
138
139
140
141
142
143
144
145
146
147
/*
 * 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, int numMove);
static int	GetBlocks(Cache *cachePtr, int bucket);
static Block *	Ptr2Block(void *ptr);
static void *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
static void	PutObjs(Cache *fromPtr, int numMove);

/*
 * Local variables defined in this file and initialized at startup.
 */

static Tcl_Mutex *listLockPtr;
static Tcl_Mutex *objLockPtr;







|


|
|
|







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
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

    /*
     * Get this thread's obj list structure and move or allocate new objs if
     * necessary.
     */

    if (cachePtr->numObjects == 0) {
	int 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 %d 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;
	}
    }








|
















|



|







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
648

649
650
651
652
653
654
655
656
657
658
659
660
661
662
	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 %" 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,
		    cachePtr->buckets[n].numWaits);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	Tcl_DStringEndSublist(dsPtr);
	cachePtr = cachePtr->nextPtr;
    }
    Tcl_MutexUnlock(listLockPtr);
}







|
>





|
<







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
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
 *----------------------------------------------------------------------
 */

static void
MoveObjs(
    Cache *fromPtr,
    Cache *toPtr,
    int 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) {
	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.







|












|







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
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
 *
 *----------------------------------------------------------------------
 */

static void
PutObjs(
    Cache *fromPtr,
    int numMove)
{
    int 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 > 0);
	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.
     */







|

|










|







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
785
786
787
788
789
790
791
792
 *----------------------------------------------------------------------
 */

static void *
Block2Ptr(
    Block *blockPtr,
    int bucket,
    unsigned int reqSize)
{
    void *ptr;

    blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
    blockPtr->sourceBucket = bucket;
    blockPtr->blockReqSize = reqSize;
    ptr = ((void *) (blockPtr + 1));







|







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
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
 *----------------------------------------------------------------------
 */

static void
PutBlocks(
    Cache *cachePtr,
    int bucket,
    int numMove)
{
    /*
     * We have numFree.  Want to shed numMove. So compute how many
     * Blocks to keep.
     */

    int 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 > 0);
	lastPtr->nextBlock = NULL;
    }

    /*
     * Aquire the lock and place the list of blocks at the front of the shared
     * cache 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
971
972
973
974
975
976
977
978
		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 > 0) {
		    blockPtr = blockPtr->nextBlock;
		}
		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
		cachePtr->buckets[bucket].lastPtr = blockPtr;
		blockPtr->nextBlock = NULL;
	    }
	}







|







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
993
994
995
996
997
998
999
1000
	 * 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) {
	    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;
	    }







|







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
1022
1023
1024
1025
1026
1027
1028
1029
	/*
	 * 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 > 0) {
	    blockPtr->nextBlock = (Block *)
		((char *) blockPtr + bucketInfo[bucket].blockSize);
	    blockPtr = blockPtr->nextBlock;
	}
	cachePtr->buckets[bucket].lastPtr = blockPtr;
	blockPtr->nextBlock = NULL;
    }







|







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
1061
1062
1063
1064
1065
1066
1067
1068

    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 ?
		1 << (NBUCKETS - 2 - i) : 1;
	bucketInfo[i].lockPtr = TclpNewAllocMutex();
    }
    TclpInitAllocCache();
}

/*
 *----------------------------------------------------------------------







|







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
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 (c) 2000 by 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"









|







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
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 (c) 2003-2004 by Joe Mistachkin
 * Copyright (c) 2008 by 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"







|
|







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
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 (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 2006-2008 by 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








|
|







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
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[20];

	    sprintf(buf, "%" TCL_LL_MODIFIER "d", id);
	    Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
	}
	return result;
    }
    case THREAD_NAMES:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);







|

|







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
7
8
9
10
11
12
13
14
/*
 * tclTimer.c --
 *
 *	This file provides timer event management facilities for Tcl,
 *	including the "after" command.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|







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
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 = TclGetStringFromObj(commandPtr, &length);
	for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
		afterPtr = afterPtr->nextPtr) {
	    tempCommand = TclGetStringFromObj(afterPtr->commandPtr,
		    &tempLength);
	    if ((length == tempLength)
		    && !memcmp(command, tempCommand, length)) {
		break;
	    }
	}
	if (afterPtr == NULL) {







|


|







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
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
# 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 (c) 2005 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the unsupported generic interfaces.

interface tclTomMath
# hooks {tclTomMathInt}
scspec EXTERN

# Declare each of the functions in the Tcl tommath interface

declare 0 {
    int MP_WUR TclBN_epoch(void)
}









|









<







1
2
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



56

57
58
59
60
61
62
63
















64
65
66
67
68
69
70
#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



#   define MODULE_SCOPE extern

#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);
















#ifdef __cplusplus
}
#endif

/* Rename the global symbols in libtommath to avoid linkage conflicts */

#ifndef TCL_WITH_EXTERNAL_TOMMATH







>
>
>
|
>







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
316




317
318
319
320
321
322
323
/* 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);
/* Slot 71 is reserved */




/* 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;







|
>
>
>
>







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
408
409
410
411
412
413
414
415
    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 */
    void (*reserved71)(void);
    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 */







|







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
553

554
555
556
557
558
559
560
/* 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 */
/* Slot 71 is reserved */

/* 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 */







|
>







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
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 (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"








|







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
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 (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"
#include "tclTomMath.h"






|
|







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
6
7
8
9
10
11
12
13
14
15
16
/*
 * tclTrace.c --
 *
 *	This file contains code to handle most trace management.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"






|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
/*
 * 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
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 = TclGetStringFromObj(objv[3], &numFlags);
	if (numFlags == 0) {
	    Tcl_DecrRefCount(opsList);
	    goto badVarOps;
	}
	for (p = flagOps; *p != 0; p++) {
	    Tcl_Obj *opObj;








|







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
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 = TclGetStringFromObj(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;







|







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
705
706
707
708
709
710
711
712
		break;
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = TclGetStringFromObj(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
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
908
909
910
911
912
913
914
915
		flags |= TCL_TRACE_UNSETS;
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(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;







|







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
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 (c) 1998 by 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.







|







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
6
7
8
9
10
11
12
13
/*
 * tclUtf.c --
 *
 *	Routines for manipulating UTF-8 strings.
 *
 * Copyright (c) 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"






|







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
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
 */

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,
/* 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,
#if TCL_UTF_MAX > 3
    4,4,4,4,4,
#else
    1,1,1,1,1,
#endif
    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,
#if TCL_UTF_MAX > 3
    4,4,4,4,4,
#else
    3,3,3,3,3,
#endif
    1,1,1,1,1,1,1,1,1,1,1
};

/*
 * Functions used only in this module.
 */

static int		Invalid(const char *src);

/*







<
>
|
<
<

|
<
<
<
<
<
<

|










|
<
<
<
<
<
<

|







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
698
699
700
701
702
703
704
705
    p = src;
    endPtr = src + length;
    optPtr = endPtr - 4;
    while (p <= optPtr) {
	p += TclUtfToUCS4(p, &ch);
	*w++ = ch;
    }
    while ((p < endPtr) && TclUCS4Complete(p, endPtr-p)) {
	p += TclUtfToUCS4(p, &ch);
	*w++ = ch;
    }
    while (p < endPtr) {
	*w++ = UCHAR(*p++);
    }
    *w = '\0';







|







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
756
757
758
759
760
761
762
763
    endPtr = src + length;
    optPtr = endPtr - 3;
    while (p <= optPtr) {
	p += Tcl_UtfToChar16(p, &ch);
	*w++ = ch;
    }
    while (p < endPtr) {
	if (TclChar16Complete(p, endPtr-p)) {
	    p += Tcl_UtfToChar16(p, &ch);
	    *w++ = ch;
	} else {
	    *w++ = UCHAR(*p++);
	}
    }
    *w = '\0';







|







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
837
838
839
840
841
842
843
844
	}
    } 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 - TCL_UTF_MAX;

	/*
	 * 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.







|







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
1068
1069
1070
1071
1072
1073
1074
1075
		/*
		 * 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 >= complete[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







|







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
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
	     * and exit this loop before we run past the start of the string.
	     */
	    return fallback;
	}

	/* Continue the search backwards... */
	look--;
    } while (trailBytesSeen < TCL_UTF_MAX);

    /*
     * We've seen TCL_UTF_MAX trail bytes, so we know there will not be a
     * properly formed byte sequence to find, and we can stop looking,
     * accepting the fallback (for TCL_UTF_MAX > 3) or just go back as
     * far as we can.
     */
#if TCL_UTF_MAX > 3
    return fallback;
#else
    return src - TCL_UTF_MAX;
#endif
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharAtIndex --
 *







|


|

|
<

<

<
<
<







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
1754
1755
1756
1757
1758
1759
1760
1761
	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.
 *







|







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
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861








1862
1863
1864
1865
1866
1867
1868

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. */
{
#ifdef WORDS_BIGENDIAN
    /*
     * 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) {








	    return (*ucs - *uct);
	}
    }
    return 0;
#endif /* WORDS_BIGENDIAN */
}








|













>
>
>
>
>
>
>
>







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
2639
2640
2641
2642
2643
2644













2645
2646
2647
2648
2649
2650
2651
2652
2653
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[01] & 0x3FF)) + 0x10000;
	return 2;
    }
    *ucs4Ptr = src[0];
    return 1;
}













#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|





>
>
>
>
>
>
>
>
>
>
>
>
>









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
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 (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclParse.h"






|
|
|







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
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 = TclUtfPrev(p, bytes);
	do {
	    pp += pInc;
 	    pInc = TclUtfToUCS4(pp, &ch1);
	} while (pp + pInc < p);

	/*
	 * Inner loop: scan trim string for match to current character.
	 */

	do {
	    size_t qInc = TclUtfToUCS4(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;
	} while (bytesLeft);

	if (bytesLeft == 0) {
	    /*
	     * No match; trim task done; *p is last non-trimmed char.
	     */








|

|










|





|
|







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
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;
    }

    /*







|







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
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971







1972
1973
1974
1975
1976
1977
1978
1979
    for (i = 0;  i < objc;  i++) {
	size_t length;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr)) {
	    continue;
	}
	(void)TclGetStringFromObj(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) {







		if (TCL_OK != Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
		    /* Abandon ship! */
		    Tcl_DecrRefCount(resPtr);
		    goto slow;
		}
	    } else {
		resPtr = TclListObjCopy(NULL, objPtr);
	    }







|












>
>
>
>
>
>
>
|







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
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
     * 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 = TclGetStringFromObj(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 = TclGetStringFromObj(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;








|
















|







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
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
     * XXX: TclReToGlob tells us about
    trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
     */

    if (TclHasIntRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) {
	Tcl_UniChar *udata, *uptn;

	udata = TclGetUnicodeFromObj(strObj, &length);
	uptn  = TclGetUnicodeFromObj(ptnObj, &plen);
	match = TclUniCharMatch(udata, length, uptn, plen, flags);
    } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
		&& !flags) {
	unsigned char *data, *ptn;

	data = TclGetByteArrayFromObj(strObj, &length);
	ptn  = TclGetByteArrayFromObj(ptnObj, &plen);
	match = TclByteArrayMatch(data, length, ptn, plen, 0);
    } else {
	match = Tcl_StringCaseMatch(TclGetString(strObj),
		TclGetString(ptnObj), flags);
    }
    return match;
}







|
|





|
|







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
2632
2633
2634
2635
2636
2637
2638
2639

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    size_t length;
    const char *bytes = TclGetStringFromObj(objPtr, &length);

    return Tcl_DStringAppend(dsPtr, bytes, length);
}

char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,







|







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
3455
3456
3457
3458
3459
3460
3461
3462
    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 = TclGetStringFromObj(objPtr, &length);

	if (*bytes != 'e') {
	    int numType;
	    const char *opPtr;
	    int len, t1 = 0, t2 = 0;

	    /* Value doesn't start with "e" */







|







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
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 (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 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"









|
|
|
|
|







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
668
669
670
671
672
673
674
675

    if (!parsed) {
	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	size_t len;
	const char *part1 = TclGetStringFromObj(part1Ptr, &len);

	if ((len > 1) && (part1[len - 1] == ')')) {
	    const char *part2 = strchr(part1, '(');

	    if (part2) {
		if (part2Ptr != NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {







|







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
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 = TclGetStringFromObj(varNamePtr, &varLen);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {
	cxtNsPtr = iPtr->globalNsPtr;







|







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
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 = TclGetStringFromObj(objPtr, &localLen);

		    if ((varLen == localLen) && (varName[0] == localNameStr[0])
			&& !memcmp(varName, localNameStr, varLen)) {
			*indexPtr = i;
			return (Var *) &varFramePtr->compiledLocals[i];
		    }
		}







|







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
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 implentation for AndroWish.
 *
 * Copyright (c) 2016-2017 Sean Woods <[email protected]>
 * Copyright (c) 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




|

|
|







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
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

#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"
#include "zutil.h"
#include "crc32.h"

#ifdef CFG_RUNTIME_DLLFILE

/*
** 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"

#else /* !CFG_RUNTIME_DLLFILE */

/*
** We are compiling from the /compat folder of tclconfig
** Pre TIP430 style zipfs prefix
** //zipfs:/ doesn't work straight out of the box on either windows or Unix
** without other changes made to tip 430
*/

#define ZIPFS_VOLUME	  "zipfs:/"
#define ZIPFS_VOLUME_LEN  7
#define ZIPFS_APP_MOUNT	  "zipfs:/app"
#define ZIPFS_ZIP_MOUNT	  "zipfs:/lib/tcl"

#endif /* CFG_RUNTIME_DLLFILE */

/*
 * Various constants and offsets found in ZIP archive files
 */

#define ZIP_SIG_LEN			4








<
<









<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<







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
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
 */

#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)

/*
 * Macros to read and write 16 and 32 bit integers from/to ZIP archives.
 */

#define ZipReadInt(p) \
    ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24))
#define ZipReadShort(p) \
    ((p)[0] | ((p)[1] << 8))

#define ZipWriteInt(p, v) \
    do {			     \
	(p)[0] = (v) & 0xff;	     \
	(p)[1] = ((v) >> 8) & 0xff;  \
	(p)[2] = ((v) >> 16) & 0xff; \
	(p)[3] = ((v) >> 24) & 0xff; \
    } while (0)
#define ZipWriteShort(p, v) \

    do {			    \
	(p)[0] = (v) & 0xff;	    \
	(p)[1] = ((v) >> 8) & 0xff; \
    } 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 */







/*
 * In-core description of mounted ZIP archive file.
 */

typedef struct ZipFile {
    char *name;			/* Archive name */
    size_t nameLength;		/* Length of archive name */







>
>
>
>
>
>
>
>








|
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
|
<
>
|
<
<



















>
>
>
>
>
>







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
231
232
233
234
235
236
237
238
#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 */
    Tcl_WideInt 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 */







>





|







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
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
 * 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 */










    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, 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 inline int	DescribeMounted(Tcl_Interp *interp,
			    const char *mountPoint);




static inline int	ListMountPoints(Tcl_Interp *interp);
















static int		ZipfsAppHookFindTclInit(const char *archive);

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 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 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);

static Tcl_WideInt ZipChannelWideSeek(void *instanceData, Tcl_WideInt 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.







|
>
>
>
>
>
>
>
>
>
>




|
















>
>


>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>











>
>
>










>
>







>
|

>
>
>







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
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
    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,
    NULL,	    /* Close channel, clean instance data */
    ZipChannelRead,	    /* Handle read request */
    ZipChannelWrite,	    /* Handle write request */



	NULL,	    /* Move location of access point, NULL'able */

    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 */
};
















































































/*
 *-------------------------------------------------------------------------
 *
 * ReadLock, WriteLock, Unlock --
 *
 *	POSIX like rwlock functions to support multiple readers and single







|









|

|
|
|
>
>
>
|
>
|
|
|
|
|
|
>
|
|
|
|
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
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

TCL_DECLARE_MUTEX(ZipFSMutex)

#if TCL_THREADS

static Tcl_Condition ZipFSCond;

static 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 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 void
Unlock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    if (ZipFS.lock > 0) {
	--ZipFS.lock;
    } else if (ZipFS.lock < 0) {
	ZipFS.lock = 0;







|












|












|







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
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585













































































































586
587
588
589
590
591
592
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
CountSlashes(
    const char *string)
{
    int count = 0;
    const char *p = string;

    while (*p != '\0') {
	if (*p == '/') {
	    count++;
	}
	p++;
    }
    return count;
}














































































































/*
 *-------------------------------------------------------------------------
 *
 * CanonicalPath --
 *
 *	This function computes the canonical path from a directory and file







|














>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
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
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static ZipEntry *
ZipFSLookup(
    char *filename)
{
    Tcl_HashEntry *hPtr;
    ZipEntry *z = NULL;

    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename);
    if (hPtr) {
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
    }
    return z;
}











































































/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookupMount --
 *
 *	This function returns an indication if the given file name corresponds
 *	to a mounted ZIP archive file.
 *
 * Results:
 *	Returns true, if the given file name is a mounted ZIP archive file.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#ifdef NEVER_USED
static int
ZipFSLookupMount(
    char *filename)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	   hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = Tcl_GetHashValue(hPtr);

	if (strcmp(zf->mountPoint, filename) == 0) {
	    return 1;

	}

    }
    return 0;
}
#endif /* NEVER_USED */

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCloseArchive --
 *
 *	This function closes a mounted ZIP archive file.







|

|






|



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|

<
<
|
<
<
<

|
<
>
|
>

|

<







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
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
	    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);
	zf->data = (unsigned char *)MAP_FAILED;
    }
#endif /* _WIN32 */

    if (zf->ptrToFree) {
	Tcl_Free(zf->ptrToFree);
	zf->ptrToFree = NULL;
    }
    if (zf->chan) {
	Tcl_CloseEx(interp, zf->chan, 0);
	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.
 *
 * 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;
    unsigned char *p, *q;









    p = zf->data + zf->length - ZIP_CENTRAL_END_LEN;
    while (p >= zf->data) {
	if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) {
	    if (ZipReadInt(p) == ZIP_CENTRAL_END_SIG) {
		break;
	    }
	    p -= ZIP_SIG_LEN;
	} else {
	    --p;
	}
    }
    if (p < zf->data) {





	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "wrong end signature");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "END_SIG", NULL);
	}
	goto error;



    }
    zf->numFiles = ZipReadShort(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");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
	}
	goto error;



    }
    q = zf->data + ZipReadInt(p + ZIP_CENTRAL_DIRSTART_OFFS);
    p -= ZipReadInt(p + ZIP_CENTRAL_DIRSIZE_OFFS);
    if ((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");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_DIR", NULL);
	}
	goto error;



    }
    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 > zf->data + zf->length) {
	    ZIPFS_ERROR(interp, "wrong header length");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_LEN", NULL);
	    }
	    goto error;
	}
	if (ZipReadInt(q) != ZIP_CENTRAL_HEADER_SIG) {
	    ZIPFS_ERROR(interp, "wrong header signature");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_SIG", NULL);
	    }
	    goto error;
	}
	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }






    q = zf->data + zf->baseOffset;
    if ((zf->baseOffset >= 6) && (ZipReadInt(q - 4) == ZIP_PASSWORD_END_SIG)) {



	i = q[-5];
	if (q - 5 - i > zf->data) {

	    zf->passBuf[0] = i;
	    memcpy(zf->passBuf + 1, q - 5 - i, i);
	    zf->passOffset -= i ? (5 + i) : 0;
	}
    }
    return TCL_OK;

  error:
    ZipFSCloseArchive(interp, zf);







>
>
>
>











|








|











|



















|
>
>

>
>
>
>
>
>

|

|








>
>
>
>
>





|
|
|
|
>
>
>
|
|






|
|
|
|
>
>
>
|
|
|
|






|
|
|
|
>
>
>
|






|

|
<
<


|

|
<
<


|
|
|


>
>
>
>
>
>

|
>
>
>

|
>

|







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
1042
1043
1044
1045
1046
1047
1048





1049
1050
1051
1052










1053









1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136







1137









1138
























































































1139

1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183













1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222



1223
1224
1225
1226

1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268


1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306

1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339

1340
1341
1342
1343
1344
1345
1346
1347
1348

1349
1350
1351
1352
1353
1354
1355
1356

1357

1358
1359
1360
1361
1362
1363

1364

1365
1366
1367
1368
1369
1370
1371


1372
1373
1374
1375
1376
1377
1378
1379
1380






1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393



1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423

    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;





    zf->chan = Tcl_OpenFileChannel(interp, zipname, "rb", 0);
    if (!zf->chan) {
	return TCL_ERROR;
    }










    if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) {









	zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
	if (zf->length == TCL_IO_FAILURE) {
	    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");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    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_ERROR(interp, "out of memory");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    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_CloseEx(interp, zf->chan, 0);
	zf->chan = NULL;
    } else {
#ifdef _WIN32
	int readSuccessful;
#   ifdef _WIN64
	i = GetFileSizeEx((HANDLE) handle, (PLARGE_INTEGER) &zf->length);
	readSuccessful = (i != 0);
#   else /* !_WIN64 */
	zf->length = GetFileSize((HANDLE) handle, 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");
	    goto error;
	}
	zf->mountHandle = CreateFileMappingW((HANDLE) handle, 0, PAGE_READONLY,
		0, zf->length, 0);
	if (zf->mountHandle == INVALID_HANDLE_VALUE) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto 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");
	    goto error;
	}
#else /* !_WIN32 */
	zf->length = lseek(PTR2INT(handle), 0, SEEK_END);
	if (zf->length == TCL_IO_FAILURE || zf->length < ZIP_CENTRAL_END_LEN) {
	    ZIPFS_POSIX_ERROR(interp, "invalid file size");
	    goto error;
	}
	lseek(PTR2INT(handle), 0, SEEK_SET);
	zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ,
		MAP_FILE | MAP_PRIVATE, PTR2INT(handle), 0);
	if (zf->data == MAP_FAILED) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
#endif /* _WIN32 */
    }
    return ZipFSFindTOC(interp, needZip, zf);

  error:
    ZipFSCloseArchive(interp, zf);
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *







 * ZipFSRootNode --









 *
























































































 *	This function generates the root node for a ZIPFS filesystem.

 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	...

 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSCatalogFilesystem(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    ZipFile *zf0,
    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 *zf;
    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 ((pwlen > 255) || strchr(passwd, 0xff)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    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) {
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s is already mounted on %s", zf->name, mountPoint));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "MOUNTED", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    Unlock();




    *zf = *zf0;
    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);
    zf->entries = NULL;
    zf->topEnts = NULL;
    zf->numOpen = 0;
    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 = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry));
	    Tcl_SetHashValue(hPtr, z);

	    z->tnext = NULL;
	    z->depth = CountSlashes(mountPoint);
	    z->zipFilePtr = zf;
	    z->isDirectory = (zf->baseOffset == 0) ? 1 : -1; /* root marker */
	    z->isEncrypted = 0;
	    z->offset = zf->baseOffset;
	    z->crc32 = 0;
	    z->timestamp = 0;
	    z->numBytes = z->numCompressedBytes = 0;
	    z->compressMethod = ZIP_COMPMETH_STORED;
	    z->data = NULL;
	    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++) {


	int extra, isdir = 0, dosTime, dosDate, nbcompr;
	size_t offs, pathlen, comlen;
	unsigned char *lq, *gq = NULL;
	char *fullpath, *path;

	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	Tcl_DStringSetLength(&ds, 0);
	Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
	path = Tcl_DStringValue(&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(q + ZIP_CENTRAL_LOCALHDR_OFFS);
	if ((lq < zf->data) || (lq > zf->data + zf->length)) {
	    goto nextent;
	}
	nbcompr = ZipReadInt(lq + ZIP_LOCAL_COMPLEN_OFFS);
	if (!isdir && (nbcompr == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
	    gq = q;
	    nbcompr = ZipReadInt(gq + ZIP_CENTRAL_COMPLEN_OFFS);
	}
	offs = (lq - zf->data)
		+ ZIP_LOCAL_HEADER_LEN
		+ ZipReadShort(lq + ZIP_LOCAL_PATHLEN_OFFS)
		+ ZipReadShort(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);
	    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2));
	    if (hPtr) {
		/* 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 = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry));
	z->name = NULL;
	z->tnext = NULL;
	z->depth = CountSlashes(fullpath);
	z->zipFilePtr = zf;
	z->isDirectory = isdir;
	z->isEncrypted = (ZipReadShort(lq + ZIP_LOCAL_FLAGS_OFFS) & 1)

		&& (nbcompr > 12);
	z->offset = offs;
	if (gq) {
	    z->crc32 = ZipReadInt(gq + ZIP_CENTRAL_CRC32_OFFS);
	    dosDate = ZipReadShort(gq + ZIP_CENTRAL_MDATE_OFFS);
	    dosTime = ZipReadShort(gq + ZIP_CENTRAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);

	    z->compressMethod = ZipReadShort(gq + ZIP_CENTRAL_COMPMETH_OFFS);

	} else {
	    z->crc32 = ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS);
	    dosDate = ZipReadShort(lq + ZIP_LOCAL_MDATE_OFFS);
	    dosTime = ZipReadShort(lq + ZIP_LOCAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);

	    z->compressMethod = ZipReadShort(lq + ZIP_LOCAL_COMPMETH_OFFS);

	}
	z->numCompressedBytes = nbcompr;
	z->data = NULL;
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
	if (!isNew) {
	    /* should not happen but skip it anyway */
	    Tcl_Free(z);


	} else {
	    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;
	    }






	    if (!z->isDirectory && (z->depth > 1)) {
		char *dir, *end;
		ZipEntry *zd;

		Tcl_DStringSetLength(&ds, strlen(z->name) + 8);
		Tcl_DStringSetLength(&ds, 0);
		Tcl_DStringAppend(&ds, z->name, -1);
		dir = Tcl_DStringValue(&ds);
		for (end = strrchr(dir, '/'); end && (end != dir);
			end = strrchr(dir, '/')) {
		    Tcl_DStringSetLength(&ds, end - dir);
		    hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
		    if (!isNew) {



			break;
		    }
		    zd = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry));
		    zd->name = NULL;
		    zd->tnext = NULL;
		    zd->depth = CountSlashes(dir);
		    zd->zipFilePtr = zf;
		    zd->isDirectory = 1;
		    zd->isEncrypted = 0;
		    zd->offset = z->offset;
		    zd->crc32 = 0;
		    zd->timestamp = z->timestamp;
		    zd->numBytes = zd->numCompressedBytes = 0;
		    zd->compressMethod = ZIP_COMPMETH_STORED;
		    zd->data = NULL;
		    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);







|






>
>
>
>
>




>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>

|






|
<
<






|

<
|
<
<







|

<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
|
<
|
<
<
<
<
<
<
|
<
<
<
|
<
|
<
<
<
<
<
<
|
|
<
<








>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>






<
>







|







|












<
<
|
<
<
<



>
>
>
>
>
>
>
>
>
>
>
>
>


















|

|
|


|
<
<
<
|
<
<
<
<
<
<




>
>
>
|
|


>

|

|
<
<














|


<



<

<
<
<

<
|







>
>





|
|
|
<
|
<









|
|


|

|
|

|



|
|



>















|
<
















>


|
<
<



|
>



|
|
|

|
>
|
>

|
|
|

|
>
|
>


<




>
>
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
|
|
|

|
|
|
|
|
|
|
|
|
>
>
>
|
|
|
|
<
|
|
|
<
|
<
|
<
|
<
|
|
|
|
|
|
|
<







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
1491
1492
1493




1494

1495




1496

1497

1498
1499

1500
1501
1502
1503
1504
1505
1506
1507
static inline int
ListMountPoints(
    Tcl_Interp *interp)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    ZipFile *zf;


    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	if (!interp) {




	    return TCL_OK;

	}




	zf = (ZipFile *)Tcl_GetHashValue(hPtr);

	Tcl_AppendElement(interp, zf->mountPoint);

	Tcl_AppendElement(interp, zf->name);
    }

    return (interp ? TCL_OK : TCL_BREAK);
}

/*
 *-------------------------------------------------------------------------
 *
 * DescribeMounted --
 *







>

<
<
|
>
>
>
>
|
>
|
>
>
>
>
|
>
|
>
|

>
|







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
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
 */

static inline int
DescribeMounted(
    Tcl_Interp *interp,
    const char *mountPoint)
{
    Tcl_HashEntry *hPtr;
    ZipFile *zf;

    if (interp) {
	hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
	if (hPtr) {
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1));
	    return TCL_OK;
	}
    }
    return (interp ? TCL_OK : TCL_BREAK);
}








|
|

<
<
|
<







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
1563

1564
1565
1566
1567
1568
1569
1570
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Mount(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    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. */
{
    ZipFile *zf;

    ReadLock();
    if (!ZipFS.initialized) {







|
>







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
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
    }
    Unlock();

    /*
     * Have both a mount point and a file (name) to mount there.
     */

    if (passwd) {
	if ((strlen(passwd) > 255) || strchr(passwd, 0xff)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    return TCL_ERROR;
	}
    }
    zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	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) {
	Tcl_Free(zf);
	return TCL_ERROR;
    }
    Tcl_Free(zf);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_MountBuffer --







|
<
<
<
<
<
<
|
|
<
|

<
<
<
<








<


<







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
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
    }
    Unlock();

    /*
     * Have both a mount point and data to mount there.
     */

    zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	return TCL_ERROR;
    }
    zf->isMemBuffer = 1;
    zf->length = datalen;
    if (copy) {
	zf->data = (unsigned char *)Tcl_AttemptAlloc(datalen);
	if (!zf->data) {
	    if (interp) {
		Tcl_AppendResult(interp, "out of memory", (char *) NULL);
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    return TCL_ERROR;
	}
	memcpy(zf->data, data, datalen);
	zf->ptrToFree = zf->data;
    } else {
	zf->data = data;
	zf->ptrToFree = NULL;
    }
    zf->passBuf[0] = 0;	/* stop valgrind cries */
    if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) {
	return TCL_ERROR;
    }
    result = ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL,
	    "Memory Buffer");
    Tcl_Free(zf);
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Unmount --







|

<
<
<
<





|

|
<
<
<








<





<







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
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

    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");

	ret = TCL_ERROR;
	goto done;
    }
    Tcl_DeleteHashEntry(hPtr);






    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;
}







|


>




>
>
>
>
>
>















>







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


1831
1832








1833


1834







1835
1836
1837
1838
1839
1840
1841
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;
    }



    return TclZipfs_Mount(interp, (objc > 1) ? TclGetString(objv[1]) : NULL,








	    (objc > 2) ? TclGetString(objv[2]) : NULL,


	    (objc > 3) ? TclGetString(objv[3]) : NULL);







}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountBufferObjCmd --
 *







>
>
>






>
>
|
|
>
>
>
>
>
>
>
>
|
>
>
|
>
>
>
>
>
>
>







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
1862
1863
1864
1865
1866
1867
1868
1869
    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 = 0;

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?");
	return TCL_ERROR;
    }
    if (objc < 2) {
	int ret;







|







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
1942
1943
1944
1945
1946
1947
1948
1949
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]));
}








<







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
1975


1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989



1990
1991
1992
1993
1994
1995
1996
1997
1998
1999

2000


2001

















2002








2003



2004




2005






2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016



2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032

2033
2034
2035
2036
2037
2038

2039


2040
2041
2042
2043

2044


2045
2046
2047

2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064






2065
2066
2067
2068
2069

2070
2071
2072
2073

2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093





2094
2095
2096
2097
2098

2099
2100
2101
2102

2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117

2118
2119






2120






2121
2122
2123
2124
2125
2126
2127

2128

2129
2130






2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146





2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195





2196
2197





2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208

2209
2210

2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232

2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249

2250
2251
2252
2253
2254





2255
2256

2257
2258
2259
2260

2261
2262
2263
2264
2265
2266
2267
2268


2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299






2300
2301
2302
2303
2304


2305
2306
2307
2308
2309
2310
2311
2312
2313





2314

2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373





















































































2374
2375
2376
2377
2378
2379




2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393



2394








2395
2396

2397
2398
2399
2400




2401



2402
2403
2404
2405
2406
2407


2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422



2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435

2436
2437
2438
2439
2440
2441

2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465

2466



2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
ZipFSMkKeyObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int len, i = 0;
    char *pw, passBuf[264];



    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = TclGetString(objv[1]);
    len = strlen(pw);
    if (len == 0) {
	return TCL_OK;
    }
    if ((len > 255) || strchr(pw, 0xff)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1));
	return TCL_ERROR;
    }



    while (len > 0) {
	int ch = pw[len - 1];

	passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	i++;
	len--;
    }
    passBuf[i] = i;
    ++i;
    passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;

    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);


    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);

















    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);








    passBuf[i] = '\0';



    Tcl_AppendResult(interp, passBuf, (char *) NULL);




    return TCL_OK;






}

/*
 *-------------------------------------------------------------------------
 *
 * ZipAddFile --
 *
 *	This procedure is used by ZipFSMkZipOrImgCmd() 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.



 *
 * 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. */
    const char *path,
    const char *name,

    Tcl_Channel out,
    const char *passwd,		/* Password for encoding the file, or NULL if
				 * the file is to be unprotected. */
    char *buf,
    int bufsize,
    Tcl_HashTable *fileHash)

{


    Tcl_Channel in;
    Tcl_HashEntry *hPtr;
    ZipEntry *z;
    z_stream stream;

    const char *zpath;


    int crc, flush, zpathlen;
    size_t nbyte, nbytecompr, len, olen, align = 0;
    Tcl_WideInt pos[3];

    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.
     */

    zpath = name;
    while (zpath && zpath[0] == '/') {
	zpath++;
    }
    if (!zpath || (zpath[0] == '\0')) {
	return TCL_OK;
    }







    zpathlen = strlen(zpath);
    if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"path too long for \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "PATH_LEN", NULL);

	return TCL_ERROR;
    }
    in = Tcl_OpenFileChannel(interp, path, "rb", 0);
    if (!in) {

#ifdef _WIN32
	/* hopefully a directory */
	if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
	    Tcl_CloseEx(interp, in, 0);
	    return TCL_OK;
	}
#endif /* _WIN32 */
	Tcl_CloseEx(interp, in, 0);
	return TCL_ERROR;
    } else {
	Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1);
	Tcl_StatBuf statBuf;

	Tcl_IncrRefCount(pathObj);
	if (Tcl_FSStat(pathObj, &statBuf) != -1) {
	    mtime = statBuf.st_mtime;
	}
	Tcl_DecrRefCount(pathObj);
    }
    Tcl_ResetResult(interp);





    crc = 0;
    nbyte = nbytecompr = 0;
    while (1) {
	len = Tcl_Read(in, buf, bufsize);
	if (len == TCL_IO_FAILURE) {

	    if (nbyte == 0 && errno == EISDIR) {
		Tcl_CloseEx(interp, in, 0);
		return TCL_OK;
	    }

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
		    path, Tcl_PosixError(interp)));
	    Tcl_CloseEx(interp, in, 0);
	    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",
		path, Tcl_PosixError(interp)));
	Tcl_CloseEx(interp, in, 0);

	return TCL_ERROR;
    }






    pos[0] = Tcl_Tell(out);






    memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen);
    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
    if (Tcl_Write(out, buf, len) != len) {
    wrerr:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error on %s: %s", path, Tcl_PosixError(interp)));

	Tcl_CloseEx(interp, in, 0);

	return TCL_ERROR;
    }






    if ((len + pos[0]) & 3) {
	unsigned char abuf[8];

	/*
	 * Align payload to next 4-byte boundary using a dummy extra entry
	 * similar to the zipalign tool from Android's SDK.
	 */

	align = 4 + ((len + pos[0]) & 3);
	ZipWriteShort(abuf, 0xffff);
	ZipWriteShort(abuf + 2, align - 4);
	ZipWriteInt(abuf + 4, 0x03020100);
	if (Tcl_Write(out, (const char *) abuf, align) != align) {
	    goto wrerr;
	}
    }





    if (passwd) {
	int i, ch, tmp;
	unsigned char kvbuf[24];
	Tcl_Obj *ret;

	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    double r;

	    if (Tcl_EvalEx(interp, "::tcl::mathfunc::rand", -1, 0) != TCL_OK) {
		Tcl_Obj *eiPtr = Tcl_ObjPrintf(
			"\n    (evaluating PRNG step %d for password encoding)",
			i);

		Tcl_AppendObjToErrorInfo(interp, eiPtr);
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    ret = Tcl_GetObjResult(interp);
	    if (Tcl_GetDoubleFromObj(interp, ret, &r) != TCL_OK) {
		Tcl_Obj *eiPtr = Tcl_ObjPrintf(
			"\n    (evaluating PRNG step %d for password encoding)",
			i);

		Tcl_AppendObjToErrorInfo(interp, eiPtr);
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    ch = (int) (r * 256);
	    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) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error on %s: %s", path, Tcl_PosixError(interp)));
	    Tcl_CloseEx(interp, in, 0);
	    return TCL_ERROR;
	}
	memcpy(keys0, keys, sizeof(keys0));
	nbytecompr += 12;
    }





    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);





    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\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE_INIT", NULL);
	Tcl_CloseEx(interp, in, 0);

	return TCL_ERROR;
    }

    do {
	len = Tcl_Read(in, buf, bufsize);
	if (len == TCL_IO_FAILURE) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "read error on %s: %s", path, Tcl_PosixError(interp)));
	    deflateEnd(&stream);
	    Tcl_CloseEx(interp, in, 0);
	    return TCL_ERROR;
	}
	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", path));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE", NULL);
		deflateEnd(&stream);
		Tcl_CloseEx(interp, in, 0);

		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 && (Tcl_Write(out, obuf, olen) != olen)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		deflateEnd(&stream);
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;

	    }
	    nbytecompr += olen;
	} while (stream.avail_out == 0);
    } while (flush != Z_FINISH);
    deflateEnd(&stream);





    Tcl_Flush(out);
    pos[1] = 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, pos[2], SEEK_SET) != pos[2]) {
	seekErr:
	    Tcl_CloseEx(interp, in, 0);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "seek error: %s", Tcl_PosixError(interp)));


	    return TCL_ERROR;
	}
	nbytecompr = (passwd ? 12 : 0);
	while (1) {
	    len = Tcl_Read(in, buf, bufsize);
	    if (len == TCL_IO_FAILURE) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"read error on \"%s\": %s",
			path, Tcl_PosixError(interp)));
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    } 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 (Tcl_Write(out, buf, len) != len) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    nbytecompr += len;
	}
	compMeth = ZIP_COMPMETH_STORED;






	Tcl_Flush(out);
	pos[1] = Tcl_Tell(out);
	Tcl_TruncateChannel(out, pos[1]);
    }
    Tcl_CloseEx(interp, in, 0);



    hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"non-unique path name \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DUPLICATE_PATH", NULL);
	return TCL_ERROR;
    }






    z = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry));

    Tcl_SetHashValue(hPtr, z);
    z->name = NULL;
    z->tnext = NULL;
    z->depth = 0;
    z->zipFilePtr = NULL;
    z->isDirectory = 0;
    z->isEncrypted = (passwd ? 1 : 0);
    z->offset = pos[0];
    z->crc32 = crc;
    z->timestamp = mtime;
    z->numBytes = nbyte;
    z->numCompressedBytes = nbytecompr;
    z->compressMethod = compMeth;
    z->data = NULL;
    z->name = (char *)Tcl_GetHashKey(fileHash, hPtr);
    z->next = NULL;

    /*
     * Write final local header information.
     */
    ZipWriteInt(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
    ZipWriteShort(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
    ZipWriteShort(buf + ZIP_LOCAL_FLAGS_OFFS, z->isEncrypted);
    ZipWriteShort(buf + ZIP_LOCAL_COMPMETH_OFFS, z->compressMethod);
    ZipWriteShort(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp));
    ZipWriteShort(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp));
    ZipWriteInt(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32);
    ZipWriteInt(buf + ZIP_LOCAL_COMPLEN_OFFS, z->numCompressedBytes);
    ZipWriteInt(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->numBytes);
    ZipWriteShort(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen);
    ZipWriteShort(buf + ZIP_LOCAL_EXTRALEN_OFFS, align);
    if (Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) {
	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, pos[1], SEEK_SET) != pos[1]) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *





















































































 * ZipFSMkZipOrImgObjCmd --
 *
 *	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.




 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A new ZIP archive file or image file is written.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipOrImgObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int isImg,



    int isList,








    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */

{
    Tcl_Channel out;
    int pwlen = 0, count, ret = TCL_ERROR, lobjc;
    size_t len, slen = 0, i = 0;




    Tcl_WideInt pos[3];



    Tcl_Obj **lobjv, *list = NULL;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable fileHash;
    char *strip = NULL, *pw = NULL, passBuf[264], buf[4096];



    /*
     * Caller has verified that the number of arguments is correct.
     */

    passBuf[0] = 0;
    if (objc > (isList ? 3 : 4)) {
	pw = TclGetString(objv[isList ? 3 : 4]);
	pwlen = strlen(pw);
	if ((pwlen > 255) || strchr(pw, 0xff)) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("illegal password", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    return TCL_ERROR;
	}



    }
    if (isList) {
	list = objv[2];
	Tcl_IncrRefCount(list);
    } else {
	Tcl_Obj *cmd[3];

	cmd[1] = Tcl_NewStringObj("::tcl::zipfs::find", -1);
	cmd[2] = objv[2];
	cmd[0] = Tcl_NewListObj(2, cmd + 1);
	Tcl_IncrRefCount(cmd[0]);
	if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) {
	    Tcl_DecrRefCount(cmd[0]);

	    return TCL_ERROR;
	}
	Tcl_DecrRefCount(cmd[0]);
	list = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(list);
    }

    if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (isList && (lobjc % 2)) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("need even number of elements", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "LIST_LENGTH", NULL);
	return TCL_ERROR;
    }
    if (lobjc == 0) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
	return TCL_ERROR;
    }
    out = Tcl_OpenFileChannel(interp, TclGetString(objv[1]), "wb", 0755);
    if (out == NULL) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (pwlen <= 0) {
	pw = NULL;

	pwlen = 0;



    }
    if (isImg) {
	ZipFile *zf, zf0;
	int isMounted = 0;
	const char *imgName;

	if (isList) {
	    imgName = (objc > 4) ? TclGetString(objv[4]) :
		    Tcl_GetNameOfExecutable();
	} else {
	    imgName = (objc > 5) ? TclGetString(objv[5]) :
		    Tcl_GetNameOfExecutable();
	}
	if (pwlen) {
	    i = 0;
	    for (len = pwlen; len-- > 0;) {
		int ch = pw[len];

		passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
		i++;







|
>
>





|
<



<
|


>
>
>



|
<



|
|
>
|
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
|
>
>
>
>

>
>
>
>
>
>







|



>
>
>














|
|
>
|


|
|
|
>

>
>




>
|
>
>


<
>









|
|
|

|



>
>
>
>
>
>
|


|
|
>


|

>



|



|


<


<



<


>
>
>
>
>




|
>

|


>

|
|










|
|
>


>
>
>
>
>
>
|
>
>
>
>
>
>

|

|
|

|
>
|
>


>
>
>
>
>
>
|

|
|
<
<
<

|
|
|
|
|
|


>
>
>
>
>



<



<
|
<
<
<
<
<
<
|


<
<
<
<
<
<
<
<
<
<
<












<
|
<
<




>
>
>
>
>

|
>
>
>
>
>








|
|
|
>


>


|
<
<

|
<










|
|

|
>











|
<
<

<
<
>





>
>
>
>
>

|
>




>



|

<


>
>





|
<
<
|
<
<











|
<
|
<
<




>
>
>
>
>
>

|
|

|
>
>

|


|
|



>
>
>
>
>
|
>

<
<
<
<
<

|





<
|
<




|
|
<
<
<
<
<
<
<
<
|
|














|












>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|




|
>
>
>
>











|

|
>
>
>
|
>
>
>
>
>
>
>
>
|
|
>


|
|
>
>
>
>
|
>
>
>
|





>
>






|
|
<
<
|
<
<


>
>
>
|
<
<
<
<
<
|
<
|
<
<
|
<
>


<
<
<

>




|

<
|
|




|
|


|




|
<
>
|
>
>
>
|





|
|
|
<
<
<
<







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
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
	/*
	 * 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;

	}
	if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) {




	    if (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_CloseEx(interp, out, 0);
		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 {
	    size_t k;
	    int m, n;
	    Tcl_Channel in;
	    const char *errMsg = "seek error";

	    /*
	     * Fall back to read it as plain file which hopefully is a static
	     * tclsh or wish binary with proper zipfs infrastructure built in.
	     */

	    Tcl_ResetResult(interp);
	    in = Tcl_OpenFileChannel(interp, imgName, "rb", 0644);
	    if (!in) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_CloseEx(interp, out, 0);
		return TCL_ERROR;
	    }
	    i = Tcl_Seek(in, 0, SEEK_END);
	    if (i == TCL_IO_FAILURE) {
	    cperr:
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"%s: %s", errMsg, Tcl_PosixError(interp)));
		Tcl_CloseEx(interp, out, 0);
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    Tcl_Seek(in, 0, SEEK_SET);
	    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 cperr;
		} else if (n == 0) {
		    break;
		}
		m = Tcl_Write(out, buf, n);
		if (m != n) {
		    errMsg = "write error";
		    goto cperr;
		}
	    }

	    Tcl_CloseEx(interp, in, 0);

	}
	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_CloseEx(interp, out, 0);
		return TCL_ERROR;
	    }
	}
	memset(passBuf, 0, sizeof(passBuf));
	Tcl_Flush(out);
    }





    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
    pos[0] = Tcl_Tell(out);
    if (!isList && (objc > 3)) {
	strip = TclGetString(objv[3]);

	slen = strlen(strip);
    }

    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = TclGetString(lobjv[i]);
	if (isList) {
	    name = TclGetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	if (ZipAddFile(interp, path, name, out, pw, buf, sizeof(buf),
		&fileHash) != TCL_OK) {
	    goto done;
	}
    }





    pos[1] = Tcl_Tell(out);
    count = 0;
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = TclGetString(lobjv[i]);
	if (isList) {
	    name = TclGetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
	len = strlen(z->name);
	ZipWriteInt(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isEncrypted);
	ZipWriteShort(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->compressMethod);
	ZipWriteShort(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp));
	ZipWriteShort(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp));
	ZipWriteInt(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32);
	ZipWriteInt(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->numCompressedBytes);
	ZipWriteInt(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->numBytes);
	ZipWriteShort(buf + ZIP_CENTRAL_PATHLEN_OFFS, len);
	ZipWriteShort(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_IATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_EATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]);
	if ((Tcl_Write(out, buf,
		    ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN)
		|| (Tcl_Write(out, z->name, len) != len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error: %s", Tcl_PosixError(interp)));

	    goto done;
	}

	count++;
    }





    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);
    ZipWriteInt(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_ENTS_OFFS, count);
    ZipWriteShort(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]);
    ZipWriteShort(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);


    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_CloseEx(interp, out, 0);
    } else {
	Tcl_CloseEx(interp, out, 0);
    }
    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;
}






























































































































































































/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipObjCmd, ZipFSLMkZipObjCmd --
 *
 *	These procedures are invoked to process the [zipfs mkzip] and [zipfs
 *	lmkzip] commands.  See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{


    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile indir ?strip? ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }



    return ZipFSMkZipOrImgObjCmd(interp, 0, 0, objc, objv);

}

static int
ZipFSLMkZipObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{


    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }


    return ZipFSMkZipOrImgObjCmd(interp, 0, 1, objc, objv);

}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkImgObjCmd, ZipFSLMkImgObjCmd --
 *
 *	These procedures are invoked to process the [zipfs mkimg] and [zipfs
 *	lmkimg] commands.  See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkImgObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{


    if (objc < 3 || objc > 6) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"outfile indir ?strip? ?password? ?infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }




    return ZipFSMkZipOrImgObjCmd(interp, 1, 0, objc, objv);

}

static int
ZipFSLMkImgObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{


    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }



    return ZipFSMkZipOrImgObjCmd(interp, 1, 1, objc, objv);

}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCanonicalObjCmd --
 *







|







>


>


>
>
>
>
|





|

















<
<
<
<
<





<
|
<


|


<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
>
|
>
|







|






>
>
>
>
>

|
|
|
>
|
|
>
|
|
|
<
<
|
<
<
<
<
<
<
|
<
<
<
<
<
<



|




>
>
>
>
>
|

|
|
|
|
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<




|
|
|
|
|
<
<
<
<
<
<
<
|
<
<
<
<
<
<
|
|
|


>


>


>
>
>
>
>

|
<
<
<
<
<
<
<
<
>
>










|

|




|






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







|





|











>
>





<
|
|


>
>
>
|
>









>
>





<
|
|


>
>
|
>








|





|











>
>






<
|
|


>
>
>
>
|
>









>
>





<
|
|


>
>
>
|
>







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
2955
2956
2957
2958
2959
2960
2961
2962
}

/*
 *-------------------------------------------------------------------------
 *
 * 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.
 *







|







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
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
    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) {
	size_t n;
	char *what = TclGetStringFromObj(objv[1], &n);




	if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) {


	    pattern = TclGetString(objv[2]);
	} else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) {


	    regexp = Tcl_RegExpCompile(interp, TclGetString(objv[2]));
	    if (!regexp) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown option \"%s\"", what));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_OPT", NULL);
	    return TCL_ERROR;
	}
    } else if (objc == 2) {
	pattern = TclGetString(objv[1]);
    }





    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;







>
>
>
>
>
>






|
|
>
>
>
|
<
>
>

<
>
>




<
<
<
<
|




>
>
>
>
>




|









|









|







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
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118

3119
3120
3121
3122
3123
3124
3125
 * Side effects:
 *	May initialise the cache of where such library files are to be found.
 *	This cache is never cleared.
 *
 *-------------------------------------------------------------------------
 */

#ifdef _WIN32
#define LIBRARY_SIZE	    64
#endif /* _WIN32 */

Tcl_Obj *
TclZipfs_TclLibrary(void)
{
    Tcl_Obj *vfsInitScript;
    int found;
#ifdef _WIN32

    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







<
<
<
<





|
>







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

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
    }

    /*
     * 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(_WIN32)
    hModule = (HMODULE)TclWinGetTclInstance();
    GetModuleFileNameW(hModule, wName, MAX_PATH);



    WideCharToMultiByte(CP_UTF8, 0, wName, -1, dllName, sizeof(dllName), NULL, NULL);


    if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#elif /* !_WIN32 && */ defined(CFG_RUNTIME_DLLFILE)
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#endif /* _WIN32 || CFG_RUNTIME_DLLFILE */

    /*
     * If we're configured to know about a ZIP archive we should use, do that.
     */

#ifdef CFG_RUNTIME_ZIPFILE
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    if (ZipfsAppHookFindTclInit(CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#endif /* CFG_RUNTIME_ZIPFILE */

    /*
     * If anything set the cache (but subsequently failed) go with that
     * anyway.
     */

    if (zipfs_literal_tcl_library) {







>
|


>
>
>

>




|
<
|


|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272

3273
3274
3275
3276
3277
3278
3279

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;







|















|
>







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
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
 *
 * Side effects:
 *	File pointer is repositioned according to offset and mode.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_WideInt
ZipChannelWideSeek(
    void *instanceData,
    Tcl_WideInt offset,
    int mode,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    size_t end;

    if (!info->isWriting && (info->isDirectory < 0)) {







|


|







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
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

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelOpen --
 *
 *	This function opens a Tcl_Channel on a file from a mounted ZIP archive
 *	according to given open mode.
 *
 * 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,
    int mode,
    TCL_UNUSED(int) /*permissions*/)
{
    ZipEntry *z;
    ZipChannel *info;
    int i, ch, trunc, wr, flags = 0;
    char cname[128];

    if ((mode & O_APPEND)
	    || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) {

	if (interp) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unsupported open mode", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_MODE", NULL);

	}
	return NULL;
    }
    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;
    }
    trunc = (mode & O_TRUNC) != 0;



    wr = (mode & (O_WRONLY | O_RDWR)) != 0;
    if ((z->compressMethod != ZIP_COMPMETH_STORED)
	    && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) {
	ZIPFS_ERROR(interp, "unsupported compression method");

	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "COMP_METHOD", NULL);


	}
	goto error;
    }
    if (wr && z->isDirectory) {

	ZIPFS_ERROR(interp, "unsupported file type");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_TYPE", NULL);
	}
	goto error;
    }
    if (!trunc) {
	flags |= TCL_READABLE;
	if (z->isEncrypted && (z->zipFilePtr->passBuf[0] == 0)) {
	    ZIPFS_ERROR(interp, "decryption failed");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DECRYPT", NULL);
	    }
	    goto error;
	} else if (wr && !z->data && (z->numBytes > ZipFS.wrmax)) {
	    ZIPFS_ERROR(interp, "file too large");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
    } else {
	flags = TCL_WRITABLE;
    }
    info = (ZipChannel *)Tcl_AttemptAlloc(sizeof(ZipChannel));

    if (!info) {
	ZIPFS_ERROR(interp, "out of memory");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	goto error;
    }
    info->zipFilePtr = z->zipFilePtr;
    info->zipEntryPtr = z;
    info->numRead = 0;
    if (wr) {




	flags |= TCL_WRITABLE;








	info->isWriting = 1;


	info->isDirectory = 0;




	info->maxWrite = ZipFS.wrmax;


	info->iscompr = 0;



	info->isEncrypted = 0;



	info->ubuf = (unsigned char *)Tcl_AttemptAlloc(info->maxWrite);





	if (!info->ubuf) {
	merror0:



	    if (info->ubuf) {









		Tcl_Free(info->ubuf);







	    }
	    Tcl_Free(info);

	    ZIPFS_ERROR(interp, "out of memory");








	    if (interp) {



		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);


	    }


	    goto error;
	}
	memset(info->ubuf, 0, info->maxWrite);

	if (trunc) {




	    info->numBytes = 0;
	} else if (z->data) {




	    size_t j = z->numBytes;

	    if (j > info->maxWrite) {
		j = info->maxWrite;
	    }
	    memcpy(info->ubuf, z->data, j);
	    info->numBytes = j;
	} else {
	    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;
		unsigned char *cbuf = NULL;

		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) {
		    size_t j;

		    stream.avail_in -= 12;
		    cbuf = (unsigned char *)Tcl_AttemptAlloc(stream.avail_in);
		    if (!cbuf) {
			goto merror0;
		    }
		    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 cerror0;
		}
		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);
		    }
		    goto wrapchan;
		}
	    cerror0:
		if (cbuf) {
		    memset(info->keys, 0, sizeof(info->keys));
		    Tcl_Free(cbuf);
		}
		if (info->ubuf) {
		    Tcl_Free(info->ubuf);
		}
		Tcl_Free(info);
		ZIPFS_ERROR(interp, "decompression error");
		if (interp) {
		    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
		}
		goto error;
	    } else if (z->isEncrypted) {
		for (i = 0; i < z->numBytes - 12; i++) {
		    ch = zbuf[i];
		    info->ubuf[i] = zdecode(info->keys, crc32tab, ch);
		}
	    } else {
		memcpy(info->ubuf, zbuf, z->numBytes);
	    }
	    memset(info->keys, 0, sizeof(info->keys));
	    goto wrapchan;
	}
    } else if (z->data) {
	flags |= TCL_READABLE;
	info->isWriting = 0;
	info->iscompr = 0;
	info->isDirectory = 0;
	info->isEncrypted = 0;
	info->numBytes = z->numBytes;
	info->maxWrite = 0;
	info->ubuf = z->data;
    } else {
	flags |= TCL_READABLE;
	info->isWriting = 0;
	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;
	info->maxWrite = 0;
	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 char *ubuf = NULL;
	    size_t j;

	    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 merror;
		}
		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) {
	    merror:
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    Tcl_Free(ubuf);
		}
		Tcl_Free(info);
		if (interp) {
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj("out of memory", -1));
		    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
		}
		goto error;
	    }
	    stream.avail_out = info->numBytes;
	    if (inflateInit2(&stream, -15) != Z_OK) {
		goto cerror;
	    }
	    err = inflate(&stream, Z_SYNC_FLUSH);
	    inflateEnd(&stream);
	    if ((err == Z_STREAM_END)
		    || ((err == Z_OK) && (stream.avail_in == 0))) {
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    Tcl_Free(ubuf);
		}
		goto wrapchan;

	    }
	cerror:
	    if (ubuf) {
		info->isEncrypted = 0;
		memset(info->keys, 0, sizeof(info->keys));
		Tcl_Free(ubuf);



	    }

	    if (info->ubuf) {
		Tcl_Free(info->ubuf);
	    }
	    Tcl_Free(info);
	    ZIPFS_ERROR(interp, "decompression error");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
	    }
	    goto error;
	} else if (info->isEncrypted) {
	    unsigned char *ubuf = NULL;
	    size_t 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) {

		Tcl_Free((char *) info);








		if (interp != NULL) {

















		    Tcl_SetObjResult(interp,










			Tcl_NewStringObj("out of memory", -1));





		}




















		goto error;

	    }

















	    for (j = 0; j < len; j++) {
		ch = info->ubuf[j];
		ubuf[j] = zdecode(info->keys, crc32tab, ch);
	    }
	    info->ubuf = ubuf;

	    info->isEncrypted = 0;
	}




    }






  wrapchan:




    sprintf(cname, "zipfs_%" TCL_LL_MODIFIER "x_%d", z->offset,




	    ZipFS.idCount++);








    z->zipFilePtr->numOpen++;




    Unlock();













    return Tcl_CreateChannel(&ZipChannelType, cname, info, flags);













  error:
    Unlock();





    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipEntryStat --
 *







|













|
|
|



|


<
<
>
|
<
<
<
>
|
<
<











|
>
>
>
|
|
<
<
>

|
>
>



|
>
|
|
<
<






|
<
<



|
<
<





|
>

<
<
<
<




<

>
>
>
>

>
>
>
>
>
>
>
>
|
>
>
|
>
>
>
>
|
>
>
|
>
>
>
|
>
>
>
|
>
>
>
>
>
|
|
>
>
>
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
|
|
>
|
>
>
>
>
>
>
>
>
|
>
>
>
|
>
>
|
>
>
|
|
|
>
|
>
>
>
>
|
|
>
>
>
>
|

|
|
|
|
|
|
<
|
<
<
<
|
<
<
<
>
|
<
<
<
<
<
<
<
<
<
<
<
<
|

<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<














|

|
>


<
<






|
>
>

|
|
<
|



|

|

|

|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|

|





|
<

|

<
>

|
<
|
<
<
>
>
>
|
>
|
|

<
<
<
<
<
<
|
<
<
<

<
<
>


>
>
>
>
>
|
>
>
>
>
>
>
|
>
|
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|



|
>
|

>
>
>
>
|
>
>
>
|
>
>
|
>
>
>
>
|
>
>
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
|
|
>
>
>
>
>
|







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
3992
3993



3994
3995
3996
3997















3998
3999
4000
4001
4002
4003
4004
4005
4006
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSOpenFileChannelProc --
 *



 * Results:

 *
 * Side effects:

 *
 *-------------------------------------------------------------------------
 */

static Tcl_Channel
ZipFSOpenFileChannelProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *pathPtr,
    int mode,
    int permissions)
{



    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return NULL;
    }















    return ZipChannelOpen(interp, TclGetString(pathPtr), mode,
	    permissions);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSStatProc --
 *







>
>
>

>


>









|

>
>
>




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<







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
4024
4025
4026
4027
4028
4029
4030
4031
 */

static int
ZipFSStatProc(
    Tcl_Obj *pathPtr,
    Tcl_StatBuf *buf)
{

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryStat(TclGetString(pathPtr), 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
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126

4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146

4147


4148

4149
4150
4151
4152

4153

4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196

4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208

4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231

4232
4233



4234

4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248

4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
























































































4277
4278
4279
4280
4281
4282
4283
{
    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 *),
    Tcl_Obj *result,
    Tcl_Obj *pathPtr,
    const char *pattern,
    Tcl_GlobTypeData *types)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    int scnt, l, dirOnly = -1, strip = 0;
    size_t len, prefixLen;
    char *pat, *prefix, *path;
    Tcl_DString dsPref;

    if (!normPathPtr) {
	return -1;
    }
    if (types) {
	dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;

    }

    /*
     * The prefix that gets prepended to results.
     */

    prefix = TclGetStringFromObj(pathPtr, &prefixLen);

    /*
     * The (normalized) path we're searching.
     */

    path = TclGetStringFromObj(normPathPtr, &len);

    Tcl_DStringInit(&dsPref);
    Tcl_DStringAppend(&dsPref, prefix, prefixLen);

    if (strcmp(prefix, path) == 0) {
	prefix = NULL;
    } else {

	strip = len + 1;


    }

    if (prefix) {
	Tcl_DStringAppend(&dsPref, "/", 1);
	prefixLen++;
	prefix = Tcl_DStringValue(&dsPref);

    }

    ReadLock();
    if (types && (types->type == TCL_GLOB_TYPE_MOUNT)) {
	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;

		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)) {
			if (prefix) {
			    Tcl_DStringAppend(&dsPref, z->name, lenz);
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
					    Tcl_DStringLength(&dsPref)));
			    Tcl_DStringSetLength(&dsPref, prefixLen);
			} else {
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(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)) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, zf->mountPoint,
			    zf->mountPointLen);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				    Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(zf->mountPoint,
				    zf->mountPointLen));

		}
	    }
	}
	goto end;
    }

    if (!pattern || (pattern[0] == '\0')) {
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
	if (hPtr) {
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	    if ((dirOnly < 0) || (!dirOnly && !z->isDirectory)
		    || (dirOnly && z->isDirectory)) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, z->name, -1);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				    Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(z->name, -1));
		}

	    }
	}



	goto end;

    }

    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)) {
	    if (prefix) {
		Tcl_DStringAppend(&dsPref, z->name + strip, -1);
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				Tcl_DStringLength(&dsPref)));
		Tcl_DStringSetLength(&dsPref, prefixLen);
	    } else {
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(z->name + strip, -1));
	    }
	}
    }
    Tcl_Free(pat);

  end:
    Unlock();
    Tcl_DStringFree(&dsPref);
    return TCL_OK;
}

























































































/*
 *-------------------------------------------------------------------------
 *
 * ZipFSPathInFilesystemProc --
 *
 *	This function determines if the given path object is in the ZIP







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



















|
|
|
|




|
|

|






>















<
<

|

>
|
>
>
|
>
|

<

>

>

<
<
<
<
<
<
|
<
<
<
<
<
<
|
|
<
|
<
<

<
<
<
<
|
|
<
<
<
<
<
|
<
<
<
|
|
<
<
<
<
<
>
|
<
<
<
<
<
<
<
|
<
<
<
>
|
<
<
<
<
<

<
<
|

|
|
<
|
<
<
<
<
<
<
<
|
>
|
|
>
>
>
|
>
|
<

|










>


|






<
<
<
<
<
<
<
<
|
<









>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
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
static int
ZipFSPathInFilesystemProc(
    Tcl_Obj *pathPtr,
    TCL_UNUSED(ClientData *))
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    int ret = -1;
    size_t 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 ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) {
		    ret = TCL_OK;
		    goto endloop;
		}
	    }
	} else if ((len >= zf->mountPointLen) &&
		(strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {
	    ret = TCL_OK;
	    break;
	}
    }

  endloop:







|
<






<














|







>
|




|







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
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
static int
ZipFSFileAttrsGetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    int ret = TCL_OK;
    char *path;
    ZipEntry *z;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = TclGetString(pathPtr);
    ReadLock();
    z = ZipFSLookup(path);
    if (!z) {
	Tcl_SetErrno(ENOENT);
	ZIPFS_POSIX_ERROR(interp, "file not found");
	ret = TCL_ERROR;
	goto done;
    }
    switch (index) {
    case 0:
	TclNewIntObj(*objPtrRef, z->numBytes);
	break;
    case 1:
	TclNewIntObj(*objPtrRef, z->numCompressedBytes);
	break;
    case 2:
	TclNewIntObj(*objPtrRef, z->offset);
	break;
    case 3:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint,
		z->zipFilePtr->mountPointLen);
	break;
    case 4:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, -1);
	break;
    case 5:
	*objPtrRef = Tcl_NewStringObj("0o555", -1);
	break;



    default:
	ZIPFS_ERROR(interp, "unknown attribute");

	ret = TCL_ERROR;
    }

  done:
    Unlock();
    return ret;
}







|







|









|


|


|


|



|


|


>
>
>


>







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
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
static int
ZipFSFileAttrsSetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*index*/,
    TCL_UNUSED(Tcl_Obj *) /*pathPtr*/,
    TCL_UNUSED(Tcl_Obj *) /*objPtr*/)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "UNSUPPORTED_OP", NULL);
    }
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFilesystemPathTypeProc --







<
|
|
<







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
4611
4612
4613
4614
4615
4616
4617
4618
	 * [file dirname [info nameofexecutable]] is equal to [info
	 * nameofexecutable] due to VFS effects.
	 */

	if (execName) {
	    const char *p = strrchr(execName, '/');

	    if (p > execName + 1) {
		--p;
		objs[0] = Tcl_NewStringObj(execName, p - execName);
	    }
	}
	if (!objs[0]) {
	    objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
		    TCL_PATH_DIRNAME);







|







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
4637

4638
4639
4640
4641
4642
4643
4644
    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) {







|
>







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

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
    Unlock();

    if (interp) {
	Tcl_Command ensemble;
	Tcl_Obj *mapObj;

	Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);

	Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
		TCL_LINK_INT);



	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_PkgProvideEx(interp, "zipfs", "2.0", NULL);
    }
    return TCL_OK;
#else /* !HAVE_ZLIB */
    ZIPFS_ERROR(interp, "no zlib available");
    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    return TCL_ERROR;
#endif /* HAVE_ZLIB */
}


static int
ZipfsAppHookFindTclInit(
    const char *archive)
{
    Tcl_Obj *vfsInitScript;
    int found;








>
|
|
>
>
>












|




|




>







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
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
    if (found == 0) {
	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
	return TCL_OK;
    }

    return TCL_ERROR;
}


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
 *
 *-------------------------------------------------------------------------
 */

int
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 */
{
    char *archive;


#ifdef _WIN32
    Tcl_FindExecutable(NULL);
#else
    Tcl_FindExecutable((*argvPtr)[0]);
#endif
    archive = (char *) Tcl_GetNameOfExecutable();
    TclZipfs_Init(NULL);

    /*
     * Look for init.tcl in one of the locations mounted later in this
     * function.
     */








>





|
















|












|
>


|

|

|







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
4864
4865
4866
4867
4868
4869
4870
4871
	    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 TCL_OK;
	    }
	}
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
    } else if (*argcPtr > 1) {
	/*
	 * If the first argument is "install", run the supplied installer
	 * script.







|







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
4897
4898
4899
4900
4901
4902
4903
4904
	    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 TCL_OK;
	} 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) {







|







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
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
	    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 TCL_OK;
	    }
	}
#ifdef _WIN32
	Tcl_DStringFree(&ds);
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
    }
    return TCL_OK;
}

#ifndef HAVE_ZLIB

/*
 *-------------------------------------------------------------------------
 *







|







|







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
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
    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");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    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");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}

int
TclZipfs_Unmount(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *mountPoint)	/* Mount point path. */
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}
#endif /* !HAVE_ZLIB */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|
<
<












|
<
<









|
<
<











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
6
7
8
9
10
11
12
13
14
15
/*
 * tclZlib.c --
 *
 *	This file provides the interface to the Zlib library.
 *
 * Copyright (C) 2004-2005 Pascal Scheffers <[email protected]>
 * Copyright (C) 2005 Unitas Software B.V.
 * Copyright (c) 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.
 */





|
|
|







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
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 = TclGetStringFromObj(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 = TclGetStringFromObj(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;
	}







|




















|







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
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 = TclGetByteArrayFromObj(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 = TclGetByteArrayFromObj(compDictObj, &length);

	return deflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static inline int







|













|







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
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 = TclGetByteArrayFromObj(itemObj, &itemLen);
		Tcl_IncrRefCount(itemObj);
		zshPtr->currentInput = itemObj;
		zshPtr->stream.next_in = itemPtr;
		zshPtr->stream.avail_in = itemLen;

		/*
		 * And remove it from the list







|







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
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 = TclGetByteArrayFromObj(itemObj, &itemLen);
	    Tcl_IncrRefCount(itemObj);
	    zshPtr->currentInput = itemObj;
	    zshPtr->stream.next_in = itemPtr;
	    zshPtr->stream.avail_in = itemLen;

	    /*
	     * Remove it from the list.







|







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
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) TclGetByteArrayFromObj(itemObj, &itemLen);
		if (i == 0) {
		    count += itemLen - zshPtr->outPos;
		} else {
		    count += itemLen;
		}
	    }
	}







|







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
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 = TclGetByteArrayFromObj(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) {







|







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
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 = TclGetStringFromObj(cd->compDictObj, &length);

		Tcl_DStringAppend(dsPtr, str, length);
	    }
	    return TCL_OK;
	}
    }








|







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
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);
	Tcl_GetByteArrayFromObj(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) {







|







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

3972


3973
3974
3975
3976
3977
3978
3979

    TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");

    /*
     * Formally provide the package as a Tcl built-in.
     */


    return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL);


}

/*
 *----------------------------------------------------------------------
 *	Stubs used when a suitable zlib installation was not found during
 *	configure.
 *----------------------------------------------------------------------







>
|
>
>







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 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 --
#





|
|







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
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
    } 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 [string tolower $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 {[string tolower $dllpkg] ne [string tolower $basename]} continue
	        if {$dllfile eq {}} {
	          # Loaded statically
	          break
	        }
          set found 1
	        zipfs mount $mountpoint $dllfile
	        break
	      }
	      if {!$found} {
  	      set paths {}

  	      lappend paths [file join $root app]

    	    lappend paths [::${basename}::pkgconfig get libdir,runtime]

	        lappend paths [::${basename}::pkgconfig get bindir,runtime]




	        if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} {
  	        set zipfile [string tolower \
  	          "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"]
  	      }
  	      lappend paths [file dirname [file join [pwd] [info nameofexecutable]]]


          foreach path $paths {
            set archive [file join $path $zipfile]
            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]
	}







|
|
|


|

|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
>
|
>
|
>
>
>
>
|
<
|
|
|
>
>
|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







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
161
162
163
164
165
166
167
168
169
170
171
172
	#
	# ../../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]
	}
    }







|
|
|
|
|







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
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
	    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







|
|




|
|
|
|


|







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
239
240
241
242
243
244
245
246

# 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"







|







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
295
296
297
298
299
300
301
302
    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"
		}
	    }







|







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
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
    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







|



















|







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
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

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







|

|








|
|











|
|
|

|







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
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
# 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]
}








|
|
|
|
|
|



|

|







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
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
# 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]







|
|
|

|
|

|

|
|
|
|
|
|
|
|
|
|
|
|







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
12
13
14
15
16
17
18
19
#----------------------------------------------------------------------
#
# clock.tcl --
#
#	This file implements the portions of the [clock] ensemble that are
#	coded in Tcl.  Refer to the users' manual to see the description of
#	the [clock] command and its subcommands.
#
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#----------------------------------------------------------------------

# We must have message catalogs that support the root locale, and we need
# access to the Registry on Windows systems.











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#----------------------------------------------------------------------
#
# 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
2991
2992
2993
2994
2995
2996
2997
2998
2999
    variable CachedSystemTimeZone
    variable TimeZoneBad

    if {[set result [getenv TCL_TZ]] ne {}} {
	set timezone $result
    } elseif {[set result [getenv TZ]] ne {}} {
	set timezone $result
    }
    if {![info exists timezone]} {
        # 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]







|
<







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
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 "\u0000\u0000"} {optionValue "\u0000\u0000"}} {
	    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 "\u0000\u0000"} {
		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 "\u0000\u0000"} {
		{*}$setter var $optionValue
	    }
	    return $var
	}

	method IntervalTrigger {method} {
	    # TODO: handle subclassing







|
















|






|







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
10
11
12
13
14
15
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 (c) 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 "\u002E\u3002\uFF0E\uFF61"] {
	    if {[regexp {[^-A-Za-z0-9]} $part]} {
		if {[regexp {[^-A-Za-z0-9\u00a1-\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"
		}









|



















|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
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
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 "\u002E\u3002\uFF0E\uFF61"] {
	    if {[string match -nocase "xn--*" $part]} {
		set part [punydecode [string range $part 4 end]]
	    }
	    lappend parts $part
	}
	return [join $parts .]
    }







|







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
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 < "\u0080"} {
		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]
		}







|







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









if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return

package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde]









<

>
|
>
>
>
>
>
>
>
>
>

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
5
6
7
8
9
10
11
12
# history.tcl --
#
# Implementation of the history command.
#
# 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.
#

# The tcl::history array holds the history list and some additional
# bookkeeping variables.




|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2004 by Kevin B. Kenny.
# Copyright (c) 2018 by 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.





|
|
|
|
|











|







1
2
3
4
5
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
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 -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)} {







|







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
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]







|







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
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 {}







|



















|







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
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 0644
	    } else {
        file attributes [file join $d2 $ftail] -readonly 1
	    }
    }
  }

  if {$::tcl_platform(platform) eq {unix}} {
    file attributes $d2 -permissions 0755
  } else {
    file attributes $d2 -readonly 1
  }
}

proc ::practcl::copyDir {d1 d2 {toplevel 1}} {
  #if {$toplevel} {







|







|







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
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.14 {platform platform.tcl}
    0 platform::shell 1.1.4  {platform shell.tcl}
    1 tcltest         2.5.3  {tcltest tcltest.tcl}
  } {
    if {$isafe && !$safe} continue
    package ifneeded $package $version  [list source [file join $dir {*}$file]]
  }
}} $dir












|

|





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
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 (c) 2010-2018 by Harald Oehlmann.
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 1998 by 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,






|
|
|







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
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 {[lsearch -exact $typeArgs $arg] < 0} {
                error "invalid choice"
            }
	    return $arg
        }
	any {
	    return $arg
	}







|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 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 {}






|
|







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
4
5
6
7
8
9
10
11
12
# parray:
# Print the contents of a global array on stdout.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

proc parray {a {pattern *}} {
    upvar 1 $a array



|
|







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.14 [list source [file join $dir platform.tcl]]
package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.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
97
98
99
100
101
102
103
104
105
106
    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 {
	cygwin* {
	    set plat cygwin
	}
	windows {
	    if {$tcl_platform(platform) == "unix"} {
		set plat cygwin
	    } else {
		set plat win32
	    }
	    if {$cpu eq "amd64"} {







>









>














<
<
<







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
178




179
180
181
182

183
184
185
186
187
188
189
	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 > 8} {




		incr major -4
		append plat 10.$major
		return "${plat}-${cpu}"
	    }

	}
	linux {
	    # Look for the libc*.so and determine its version
	    # (libc5/6, libc6 further glibc 2.X)

	    set v unknown








|
>
>
>
>




>







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
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
	macosx-x86_64 {
	    lappend res macosx-i386-x86_64
	}
	macosx-ix86 {
	    lappend res macosx-universal macosx-i386-x86_64
	}
	macosx*-*    {
	    # 10.5+
	    if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} {

		switch -exact -- $cpu {
		    ix86    {
			lappend alt i386-x86_64
			lappend alt universal
		    }
		    x86_64  { lappend alt i386-x86_64 }









		    default { set alt {} }
		}

		if {$v ne ""} {
		    foreach {major minor} [split $v .] break

		    # Add 10.5 to 10.minor to patterns.
		    set res {}












		    for {set j $minor} {$j >= 5} {incr j -1} {

			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}







|







|
>
>
>
>
>
>
>
>
>






<

>
>
>
>
>
>
>
>
>
>
>
>

>
|
>







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
381
382
383
384
385
386
387
388
    return $res
}


# ### ### ### ######### ######### #########
## Ready

package provide platform 1.0.14

# ### ### ### ######### ######### #########
## Demo application

if {[info exists argv0] && ($argv0 eq [info script])} {
    puts ====================================
    parray tcl_platform







|







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.

1
2
3
4
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
package ifneeded registry 1.3.5 \
        [list load [file join $dir tclreg13.dll] registry]
<
<
<
<








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
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 (c) 1996-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# The implementation is based on namespaces. These naming conventions are
# followed:









|







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
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







|







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
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
    }

    # package name (can be empty if file is not).
    set package [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 $package to $target)"
	    return -code error "permission denied (nested load)"
	}
    }

    # Determine what kind of load is requested
    if {$file eq ""} {
	# static package loading
	if {$package eq ""} {
	    set msg "load error: empty filename and no package name"
	    Log $child $msg
	    return -code error $msg
	}
	if {!$state(staticsok)} {
	    Log $child "static packages loading disabled\
			(trying to load $package to $target)"
	    return -code error "permission denied (static package)"
	}
    } else {
	# file loading

	# get the real path from the virtual one.
	try {
	    set file [TranslatePath $child $file]







|
|











|






|
|
|




|
|
|







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
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 $package $target]
    } on error msg {
	# Some packages return no error message.
	set msg0 "load of binary library for package $package failed"
	if {$msg eq {}} {
	    set msg $msg0
	} else {
	    set msg "$msg0: $msg"
	}
	Log $child $msg
	return -code error $msg







|

|
|







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
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.3 [list source [file join $dir tcltest.tcl]]











|
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
14
15
16
17
18
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
# 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 by Scriptics Corporation.
# Copyright (c) 2000 by 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.3

    # 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)

    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]













|
|









|


















>
|
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
643
644
645
646
647
648
649
650
	    }
	}
	return $valid
    }

    proc IsVerbose {level} {
	variable Option
	return [expr {[lsearch -exact $Option(-verbose) $level] >= 0}]
    }

    # 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







|







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
1272
1273
1274
1275
1276
1277
1278
1279
    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 {chan configure $f -blocking off}]}]
	    catch {close $f}
	    set code
    }

    # Set asyncPipeClose constraint: 1 means this platform supports
    # async flush and async close on a pipe.
    #







|







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
3082



3083
3084
3085
3086
3087
3088
3089

    set fullName [file join $directory $name]

    DebugPuts 3 "[lindex [info level 0] 0]:\
	     putting ``$contents'' into $fullName"

    set fd [open $fullName w]
    chan configure $fd -translation lf



    if {[string index $contents end] eq "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd








|
>
>
>







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

3261
3262

3263
3264
3265
3266
3267
3268
3269
#    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


proc tcltest::bytestring {string} {
    return [encoding convertfrom identity $string]

}

# tcltest::OpenFiles --
#
#	used in io tests, uses testchannel
#
# Arguments:







>
>
>









>
|
|
>







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
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] \







|







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
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
	}







|







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
5


6
7
8
9
10
11
12




13
14
15
16
17
18
19
20
21
22
23
24
25
26




27
28
29
30
31
32
33
34
35
36
37
38
39
40


41

42

43
44
45
46
47
48
49
50
51
52
# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Accra) {
    {-9223372036854775808 -52 0 LMT}
    {-1640995148 0 0 GMT}


    {-1556841600 1200 1 GMT}
    {-1546388400 0 0 GMT}
    {-1525305600 1200 1 GMT}
    {-1514852400 0 0 GMT}
    {-1493769600 1200 1 GMT}
    {-1483316400 0 0 GMT}
    {-1462233600 1200 1 GMT}




    {-1451780400 0 0 GMT}
    {-1430611200 1200 1 GMT}
    {-1420158000 0 0 GMT}
    {-1399075200 1200 1 GMT}
    {-1388622000 0 0 GMT}
    {-1367539200 1200 1 GMT}
    {-1357086000 0 0 GMT}
    {-1336003200 1200 1 GMT}
    {-1325550000 0 0 GMT}
    {-1304380800 1200 1 GMT}
    {-1293927600 0 0 GMT}
    {-1272844800 1200 1 GMT}
    {-1262391600 0 0 GMT}
    {-1241308800 1200 1 GMT}




    {-1230855600 0 0 GMT}
    {-1209772800 1200 1 GMT}
    {-1199319600 0 0 GMT}
    {-1178150400 1200 1 GMT}
    {-1167697200 0 0 GMT}
    {-1146614400 1200 1 GMT}
    {-1136161200 0 0 GMT}
    {-1115078400 1200 1 GMT}
    {-1104625200 0 0 GMT}
    {-1083542400 1200 1 GMT}
    {-1073089200 0 0 GMT}
    {-1051920000 1200 1 GMT}
    {-1041466800 0 0 GMT}
    {-1020384000 1200 1 GMT}


    {-1009930800 0 0 GMT}

    {-988848000 1200 1 GMT}

    {-978394800 0 0 GMT}
    {-957312000 1200 1 GMT}
    {-946858800 0 0 GMT}
    {-925689600 1200 1 GMT}
    {-915236400 0 0 GMT}
    {-894153600 1200 1 GMT}
    {-883700400 0 0 GMT}
    {-862617600 1200 1 GMT}
    {-852164400 0 0 GMT}
}




|
>
>
|
|
|
|
|
|
|
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
|
>
|
>
|
|
|
|
|
|
|
|
|

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
4



5
6
# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Lagos) {
    {-9223372036854775808 816 0 LMT}



    {-1588464816 3600 0 WAT}
}



|
>
>
>
|

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

5
6
7
8
9
# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Nairobi) {
    {-9223372036854775808 8836 0 LMT}

    {-1309746436 10800 0 EAT}
    {-1262314800 9000 0 +0230}
    {-946780200 9900 0 +0245}
    {-315629100 10800 0 EAT}
}




>
|
|
|
|

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







































54
55




56
57
58
59
60
    {-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}







































    {-859744800 -19800 1 -0530}
    {-848255400 -21600 0 CST}




    {123919200 -18000 1 CDT}
    {129618000 -21600 0 CST}
    {409039200 -18000 1 CDT}
    {413874000 -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
80
81
82
83
84
85
86
87
88
    {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 1 EDT}
    {1446361200 -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}







|
<







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
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}
    {-1665392400 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}







|







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
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(:Asia/Gaza) {
    {-9223372036854775808 8272 0 LMT}
    {-2185409872 7200 0 EEST}
    {-933645600 10800 1 EEST}


    {-857358000 7200 0 EEST}
    {-844300800 10800 1 EEST}
    {-825822000 7200 0 EEST}
    {-812685600 10800 1 EEST}
    {-794199600 7200 0 EEST}
    {-779853600 10800 1 EEST}
    {-762656400 7200 0 EEST}
    {-748310400 10800 1 EEST}
    {-731127600 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}





|
>
>
|

|
|
|
|
|

|







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
43
44
45
46
47
48
49
50
51
52
53
54
55
    {-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}
    {334015200 10800 1 IDT}
    {337644000 7200 0 IST}
    {452556000 10800 1 IDT}
    {462232800 7200 0 IST}
    {482277600 10800 1 IDT}
    {495579600 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}







|
|
|
|

|







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
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(:Asia/Hebron) {
    {-9223372036854775808 8423 0 LMT}
    {-2185410023 7200 0 EEST}
    {-933645600 10800 1 EEST}


    {-857358000 7200 0 EEST}
    {-844300800 10800 1 EEST}
    {-825822000 7200 0 EEST}
    {-812685600 10800 1 EEST}
    {-794199600 7200 0 EEST}
    {-779853600 10800 1 EEST}
    {-762656400 7200 0 EEST}
    {-748310400 10800 1 EEST}
    {-731127600 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}





|
>
>
|

|
|
|
|
|

|







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
43
44
45
46
47
48
49
50
51
52
53
54
55
    {-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}
    {334015200 10800 1 IDT}
    {337644000 7200 0 IST}
    {452556000 10800 1 IDT}
    {462232800 7200 0 IST}
    {482277600 10800 1 IDT}
    {495579600 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}







|
|
|
|

|







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
7


8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Jerusalem) {
    {-9223372036854775808 8454 0 LMT}
    {-2840149254 8440 0 JMT}
    {-1641003640 7200 0 IST}
    {-933645600 10800 1 IDT}


    {-857358000 7200 0 IST}
    {-844300800 10800 1 IDT}
    {-825822000 7200 0 IST}
    {-812685600 10800 1 IDT}
    {-794199600 7200 0 IST}
    {-779853600 10800 1 IDT}
    {-762656400 7200 0 IST}
    {-748310400 10800 1 IDT}
    {-731127600 7200 0 IST}
    {-681962400 14400 1 IDDT}
    {-673243200 10800 1 IDT}
    {-667962000 7200 0 IST}
    {-652327200 10800 1 IDT}
    {-636426000 7200 0 IST}
    {-622087200 10800 1 IDT}
    {-608947200 7200 0 IST}
    {-591847200 10800 1 IDT}
    {-572486400 7200 0 IST}
    {-558576000 10800 1 IDT}
    {-542851200 7200 0 IST}
    {-527731200 10800 1 IDT}
    {-514425600 7200 0 IST}
    {-490845600 10800 1 IDT}
    {-482986800 7200 0 IST}
    {-459475200 10800 1 IDT}
    {-451537200 7200 0 IST}
    {-428551200 10800 1 IDT}
    {-418262400 7200 0 IST}
    {-400032000 10800 1 IDT}
    {-387428400 7200 0 IST}
    {142380000 10800 1 IDT}
    {150843600 7200 0 IST}
    {167176800 10800 1 IDT}
    {178664400 7200 0 IST}
    {334015200 10800 1 IDT}
    {337644000 7200 0 IST}
    {452556000 10800 1 IDT}
    {462232800 7200 0 IST}
    {482277600 10800 1 IDT}
    {495579600 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}






|
>
>
|

|
|
|
|
|

|
|
|
|
|
|
|

|





|
|
|
|
|

|
|




|
|
|
|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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





5






















6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:Atlantic/Bermuda) {
    {-9223372036854775808 -15558 0 LMT}





    {-1262281242 -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}




>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
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
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}
    {-1672565340 37800 1 ACDT}
    {-1665390600 34200 0 ACST}
    {-883639800 37800 1 ACDT}
    {-876126600 34200 0 ACST}
    {-860398200 37800 1 ACDT}
    {-844677000 34200 0 ACST}
    {-828343800 37800 1 ACDT}
    {-813227400 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}






|
|

|

|

|







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
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}
    {-1672567140 39600 1 AEDT}
    {-1665392400 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 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}





|
|

|

|

|







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
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}
    {-1672565340 37800 1 ACDT}
    {-1665390600 34200 0 ACST}
    {-883639800 37800 1 ACDT}
    {-876126600 34200 0 ACST}
    {-860398200 37800 1 ACDT}
    {-844677000 34200 0 ACST}
    {-828343800 37800 1 ACDT}
    {-813227400 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}







|
|

|

|

|







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


2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
# created by tools/tclZIC.tcl - do not edit



set TZData(:Australia/Currie) {
    {-9223372036854775808 34528 0 LMT}
    {-2345794528 36000 0 AEST}
    {-1680508800 39600 1 AEDT}
    {-1669892400 39600 0 AEDT}
    {-1665392400 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {47138400 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}
    {152035200 39600 1 AEDT}
    {162921600 36000 0 AEST}
    {183484800 39600 1 AEDT}
    {194976000 36000 0 AEST}
    {215539200 39600 1 AEDT}
    {226425600 36000 0 AEST}
    {246988800 39600 1 AEDT}
    {257875200 36000 0 AEST}
    {278438400 39600 1 AEDT}
    {289324800 36000 0 AEST}
    {309888000 39600 1 AEDT}
    {320774400 36000 0 AEST}
    {341337600 39600 1 AEDT}
    {352224000 36000 0 AEST}
    {372787200 39600 1 AEDT}
    {386092800 36000 0 AEST}
    {404841600 39600 1 AEDT}
    {417542400 36000 0 AEST}
    {436291200 39600 1 AEDT}
    {447177600 36000 0 AEST}
    {467740800 39600 1 AEDT}
    {478627200 36000 0 AEST}
    {499190400 39600 1 AEDT}
    {510076800 36000 0 AEST}
    {530035200 39600 1 AEDT}
    {542736000 36000 0 AEST}
    {562089600 39600 1 AEDT}
    {574790400 36000 0 AEST}
    {594144000 39600 1 AEDT}
    {606240000 36000 0 AEST}
    {625593600 39600 1 AEDT}
    {637689600 36000 0 AEST}
    {657043200 39600 1 AEDT}
    {670348800 36000 0 AEST}
    {686678400 39600 1 AEDT}
    {701798400 36000 0 AEST}
    {718128000 39600 1 AEDT}
    {733248000 36000 0 AEST}
    {749577600 39600 1 AEDT}
    {764697600 36000 0 AEST}
    {781027200 39600 1 AEDT}
    {796147200 36000 0 AEST}
    {812476800 39600 1 AEDT}
    {828201600 36000 0 AEST}
    {844531200 39600 1 AEDT}
    {859651200 36000 0 AEST}
    {875980800 39600 1 AEDT}
    {891100800 36000 0 AEST}
    {907430400 39600 1 AEDT}
    {922550400 36000 0 AEST}
    {938880000 39600 1 AEDT}
    {954000000 36000 0 AEST}
    {967305600 39600 1 AEDT}
    {985449600 36000 0 AEST}
    {1002384000 39600 1 AEDT}
    {1017504000 36000 0 AEST}
    {1033833600 39600 1 AEDT}
    {1048953600 36000 0 AEST}
    {1065283200 39600 1 AEDT}
    {1080403200 36000 0 AEST}
    {1096732800 39600 1 AEDT}
    {1111852800 36000 0 AEST}
    {1128182400 39600 1 AEDT}
    {1143907200 36000 0 AEST}
    {1159632000 39600 1 AEDT}
    {1174752000 36000 0 AEST}
    {1191686400 39600 1 AEDT}
    {1207411200 36000 0 AEST}
    {1223136000 39600 1 AEDT}
    {1238860800 36000 0 AEST}
    {1254585600 39600 1 AEDT}
    {1270310400 36000 0 AEST}
    {1286035200 39600 1 AEDT}
    {1301760000 36000 0 AEST}
    {1317484800 39600 1 AEDT}
    {1333209600 36000 0 AEST}
    {1349539200 39600 1 AEDT}
    {1365264000 36000 0 AEST}
    {1380988800 39600 1 AEDT}
    {1396713600 36000 0 AEST}
    {1412438400 39600 1 AEDT}
    {1428163200 36000 0 AEST}
    {1443888000 39600 1 AEDT}
    {1459612800 36000 0 AEST}
    {1475337600 39600 1 AEDT}
    {1491062400 36000 0 AEST}
    {1506787200 39600 1 AEDT}
    {1522512000 36000 0 AEST}
    {1538841600 39600 1 AEDT}
    {1554566400 36000 0 AEST}
    {1570291200 39600 1 AEDT}
    {1586016000 36000 0 AEST}
    {1601740800 39600 1 AEDT}
    {1617465600 36000 0 AEST}
    {1633190400 39600 1 AEDT}
    {1648915200 36000 0 AEST}
    {1664640000 39600 1 AEDT}
    {1680364800 36000 0 AEST}
    {1696089600 39600 1 AEDT}
    {1712419200 36000 0 AEST}
    {1728144000 39600 1 AEDT}
    {1743868800 36000 0 AEST}
    {1759593600 39600 1 AEDT}
    {1775318400 36000 0 AEST}
    {1791043200 39600 1 AEDT}
    {1806768000 36000 0 AEST}
    {1822492800 39600 1 AEDT}
    {1838217600 36000 0 AEST}
    {1853942400 39600 1 AEDT}
    {1869667200 36000 0 AEST}
    {1885996800 39600 1 AEDT}
    {1901721600 36000 0 AEST}
    {1917446400 39600 1 AEDT}
    {1933171200 36000 0 AEST}
    {1948896000 39600 1 AEDT}
    {1964620800 36000 0 AEST}
    {1980345600 39600 1 AEDT}
    {1996070400 36000 0 AEST}
    {2011795200 39600 1 AEDT}
    {2027520000 36000 0 AEST}
    {2043244800 39600 1 AEDT}
    {2058969600 36000 0 AEST}
    {2075299200 39600 1 AEDT}
    {2091024000 36000 0 AEST}
    {2106748800 39600 1 AEDT}
    {2122473600 36000 0 AEST}
    {2138198400 39600 1 AEDT}
    {2153923200 36000 0 AEST}
    {2169648000 39600 1 AEDT}
    {2185372800 36000 0 AEST}
    {2201097600 39600 1 AEDT}
    {2216822400 36000 0 AEST}
    {2233152000 39600 1 AEDT}
    {2248876800 36000 0 AEST}
    {2264601600 39600 1 AEDT}
    {2280326400 36000 0 AEST}
    {2296051200 39600 1 AEDT}
    {2311776000 36000 0 AEST}
    {2327500800 39600 1 AEDT}
    {2343225600 36000 0 AEST}
    {2358950400 39600 1 AEDT}
    {2374675200 36000 0 AEST}
    {2390400000 39600 1 AEDT}
    {2406124800 36000 0 AEST}
    {2422454400 39600 1 AEDT}
    {2438179200 36000 0 AEST}
    {2453904000 39600 1 AEDT}
    {2469628800 36000 0 AEST}
    {2485353600 39600 1 AEDT}
    {2501078400 36000 0 AEST}
    {2516803200 39600 1 AEDT}
    {2532528000 36000 0 AEST}
    {2548252800 39600 1 AEDT}
    {2563977600 36000 0 AEST}
    {2579702400 39600 1 AEDT}
    {2596032000 36000 0 AEST}
    {2611756800 39600 1 AEDT}
    {2627481600 36000 0 AEST}
    {2643206400 39600 1 AEDT}
    {2658931200 36000 0 AEST}
    {2674656000 39600 1 AEDT}
    {2690380800 36000 0 AEST}
    {2706105600 39600 1 AEDT}
    {2721830400 36000 0 AEST}
    {2737555200 39600 1 AEDT}
    {2753280000 36000 0 AEST}
    {2769609600 39600 1 AEDT}
    {2785334400 36000 0 AEST}
    {2801059200 39600 1 AEDT}
    {2816784000 36000 0 AEST}
    {2832508800 39600 1 AEDT}
    {2848233600 36000 0 AEST}
    {2863958400 39600 1 AEDT}
    {2879683200 36000 0 AEST}
    {2895408000 39600 1 AEDT}
    {2911132800 36000 0 AEST}
    {2926857600 39600 1 AEDT}
    {2942582400 36000 0 AEST}
    {2958912000 39600 1 AEDT}
    {2974636800 36000 0 AEST}
    {2990361600 39600 1 AEDT}
    {3006086400 36000 0 AEST}
    {3021811200 39600 1 AEDT}
    {3037536000 36000 0 AEST}
    {3053260800 39600 1 AEDT}
    {3068985600 36000 0 AEST}
    {3084710400 39600 1 AEDT}
    {3100435200 36000 0 AEST}
    {3116764800 39600 1 AEDT}
    {3132489600 36000 0 AEST}
    {3148214400 39600 1 AEDT}
    {3163939200 36000 0 AEST}
    {3179664000 39600 1 AEDT}
    {3195388800 36000 0 AEST}
    {3211113600 39600 1 AEDT}
    {3226838400 36000 0 AEST}
    {3242563200 39600 1 AEDT}
    {3258288000 36000 0 AEST}
    {3274012800 39600 1 AEDT}
    {3289737600 36000 0 AEST}
    {3306067200 39600 1 AEDT}
    {3321792000 36000 0 AEST}
    {3337516800 39600 1 AEDT}
    {3353241600 36000 0 AEST}
    {3368966400 39600 1 AEDT}
    {3384691200 36000 0 AEST}
    {3400416000 39600 1 AEDT}
    {3416140800 36000 0 AEST}
    {3431865600 39600 1 AEDT}
    {3447590400 36000 0 AEST}
    {3463315200 39600 1 AEDT}
    {3479644800 36000 0 AEST}
    {3495369600 39600 1 AEDT}
    {3511094400 36000 0 AEST}
    {3526819200 39600 1 AEDT}
    {3542544000 36000 0 AEST}
    {3558268800 39600 1 AEDT}
    {3573993600 36000 0 AEST}
    {3589718400 39600 1 AEDT}
    {3605443200 36000 0 AEST}
    {3621168000 39600 1 AEDT}
    {3636892800 36000 0 AEST}
    {3653222400 39600 1 AEDT}
    {3668947200 36000 0 AEST}
    {3684672000 39600 1 AEDT}
    {3700396800 36000 0 AEST}
    {3716121600 39600 1 AEDT}
    {3731846400 36000 0 AEST}
    {3747571200 39600 1 AEDT}
    {3763296000 36000 0 AEST}
    {3779020800 39600 1 AEDT}
    {3794745600 36000 0 AEST}
    {3810470400 39600 1 AEDT}
    {3826195200 36000 0 AEST}
    {3842524800 39600 1 AEDT}
    {3858249600 36000 0 AEST}
    {3873974400 39600 1 AEDT}
    {3889699200 36000 0 AEST}
    {3905424000 39600 1 AEDT}
    {3921148800 36000 0 AEST}
    {3936873600 39600 1 AEDT}
    {3952598400 36000 0 AEST}
    {3968323200 39600 1 AEDT}
    {3984048000 36000 0 AEST}
    {4000377600 39600 1 AEDT}
    {4016102400 36000 0 AEST}
    {4031827200 39600 1 AEDT}
    {4047552000 36000 0 AEST}
    {4063276800 39600 1 AEDT}
    {4079001600 36000 0 AEST}
    {4094726400 39600 1 AEDT}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
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
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}
    {-1672565340 37800 1 ACDT}
    {-1665390600 34200 0 ACST}
    {-883639800 37800 1 ACDT}
    {-876126600 34200 0 ACST}
    {-860398200 37800 1 ACDT}
    {-844677000 34200 0 ACST}
    {-828343800 37800 1 ACDT}
    {-813227400 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
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}
    {-1672562640 35100 1 +0945}
    {-1665387900 31500 0 +0945}
    {-883637100 35100 1 +0945}
    {-876123900 31500 0 +0945}
    {-860395500 35100 1 +0945}
    {-844674300 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}





|
|

|

|







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



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/Hobart) {
    {-9223372036854775808 35356 0 LMT}
    {-2345795356 36000 0 AEST}
    {-1680508800 39600 1 AEDT}



    {-1669892400 39600 0 AEDT}
    {-1665392400 36000 0 AEST}

    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 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}






>
>
>
|
|
>

|

|

|







1
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
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}
    {-1672567140 39600 1 AEDT}
    {-1665392400 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 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}





|
|

|

|

|







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
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}
    {-1672567140 39600 1 AEDT}
    {-1665392400 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 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}





|
|

|

|

|







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
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}
    {-1672559940 32400 1 AWDT}
    {-1665385200 28800 0 AWST}
    {-883634400 32400 1 AWDT}
    {-876121200 28800 0 AWST}
    {-860392800 32400 1 AWDT}
    {-844671600 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}





|
|

|

|







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
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}
    {-1672567140 39600 1 AEDT}
    {-1665392400 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 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}





|
|

|

|

|







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
5
6
# created by tools/tclZIC.tcl - do not edit

set TZData(:Indian/Mahe) {
    {-9223372036854775808 13308 0 LMT}
    {-2006653308 14400 0 +04}
}




|

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
8
9
10
11
12
13
14
15
# 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}
    {467298000 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}





>
>


|







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
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 (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1998 by 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.






|
|







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
240
241
242
243
244
245
246
247
248
249
250

251
252
253
254
255
256
257
258
259
260
261
262
#  else
#     define MP_WUR
#  endif
#endif

#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405)
#  define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x)))
#elif defined(_MSC_VER) && _MSC_VER >= 1500
#  define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
#else
#  define MP_DEPRECATED(x)
#endif

#ifndef MP_NO_DEPRECATED_PRAGMA
#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301)
#  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_PRAGMA(s) __pragma(message(s))
#endif
#endif

#ifndef MP_DEPRECATED_PRAGMA
#  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)







<
<
<
<
<
<
<
<



>

|
<
<
|







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
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
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;
#ifdef _MSC_VER
#define mp_get_mag_ull(a) ((unsigned __int64)mp_get_mag_u64(a))
#else
unsigned long long mp_get_mag_ull(const mp_int *a) MP_WUR;
#endif

/* 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;

#ifdef _MSC_VER
/* get integer, set integer (long long) */
#define mp_get_ll(a) ((__int64)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 __int64)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)
#else
/* get integer, set integer (long long) */
long long mp_get_ll(const mp_int *a) MP_WUR;
void mp_set_ll(mp_int *a, long long b);
mp_err mp_init_ll(mp_int *a, long long b) MP_WUR;

/* get integer, set integer (unsigned long long) */
#define mp_get_ull(a) ((unsigned long long)mp_get_ll(a))
void mp_set_ull(mp_int *a, unsigned long long b);
mp_err mp_init_ull(mp_int *a, unsigned long long b) MP_WUR;
#endif

/* 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;
#ifdef _MSC_VER
MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) unsigned __int64 mp_get_long_long(const mp_int *a) MP_WUR;
#endif
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);
#ifdef _MSC_VER
MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, unsigned __int64 b);
#endif
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;







<
|
<
<
<











<

|




|


<
<
<
<
<
<
<
<
<
<
<








<
|
<


<
|
<







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
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 \
			   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}))







|







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
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 \
	${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}'







|







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
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 -Wdeclaration-after-statement -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







|







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
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 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.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>"; };







|







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
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
		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>"; };
		F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = "<group>"; };
		F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = "<group>"; };
		F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = "<group>"; };
		F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = "<group>"; };
		F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = "<group>"; };
		F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; 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>"; };
		F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; 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>"; };







<
<
<
<
<
<


<







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
841
842
843
844
845
846
847
848
		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>"; };
		F96D448008F272BA004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; 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>"; };







<







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
1152
1153
1154
1155
1156
1157
1158
1159
				F96D3E9E08F272A7004A47F5 /* Sleep.3 */,
				F96D3E9F08F272A7004A47F5 /* socket.n */,
				F96D3EA008F272A7004A47F5 /* source.n */,
				F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */,
				F96D3EA208F272A7004A47F5 /* split.n */,
				F96D3EA308F272A7004A47F5 /* SplitList.3 */,
				F96D3EA408F272A7004A47F5 /* SplitPath.3 */,
				F96D3EA508F272A7004A47F5 /* StaticPkg.3 */,
				F96D3EA608F272A7004A47F5 /* StdChannels.3 */,
				F96D3EA708F272A7004A47F5 /* string.n */,
				F96D3EA808F272A7004A47F5 /* StringObj.3 */,
				F96D3EA908F272A7004A47F5 /* StrMatch.3 */,
				F96D3EAA08F272A7004A47F5 /* subst.n */,
				F96D3EAB08F272A7004A47F5 /* SubstObj.3 */,
				F96D3EAC08F272A7004A47F5 /* switch.n */,







|







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
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
				F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
				F96D43D208F272B8004A47F5 /* configure */,
				F96D43D308F272B8004A47F5 /* configure.ac */,
				F96D442508F272B8004A47F5 /* genStubs.tcl */,
				F96D442708F272B8004A47F5 /* index.tcl */,
				F96D442808F272B8004A47F5 /* installData.tcl */,
				F96D442908F272B8004A47F5 /* loadICU.tcl */,
				F96D442A08F272B8004A47F5 /* Makefile.in */,
				F96D442B08F272B8004A47F5 /* makeTestCases.tcl */,
				F96D442C08F272B8004A47F5 /* man2help.tcl */,
				F96D442D08F272B8004A47F5 /* man2help2.tcl */,
				F96D442E08F272B8004A47F5 /* man2html.tcl */,
				F96D442F08F272B8004A47F5 /* man2html1.tcl */,
				F96D443008F272B8004A47F5 /* man2html2.tcl */,
				F96D443108F272B8004A47F5 /* man2tcl.c */,
				F96D443208F272B8004A47F5 /* README */,
				F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
				F96D443508F272B8004A47F5 /* tcl.hpj.in */,
				F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
				F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
				F92D7F100DE777240033A13A /* tsdPerf.tcl */,
				F96D443B08F272B9004A47F5 /* uniClass.tcl */,
				F96D443C08F272B9004A47F5 /* uniParse.tcl */,
			);
			path = tools;







<

<
<
<
<
<
<


<







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
1747
1748
1749
1750
1751
1752
1753
1754
				F96D447808F272BA004A47F5 /* makefile.vc */,
				F96D447908F272BA004A47F5 /* nmakehlp.c */,
				F96D447A08F272BA004A47F5 /* README */,
				F96D447C08F272BA004A47F5 /* rules.vc */,
				F96D447D08F272BA004A47F5 /* stub16.c */,
				F96D447E08F272BA004A47F5 /* tcl.dsp */,
				F96D447F08F272BA004A47F5 /* tcl.dsw */,
				F96D448008F272BA004A47F5 /* tcl.hpj.in */,
				F96D448108F272BA004A47F5 /* tcl.m4 */,
				F96D448208F272BA004A47F5 /* tcl.rc */,
				F96D448308F272BA004A47F5 /* tclAppInit.c */,
				F96D448408F272BA004A47F5 /* tclConfig.sh.in */,
				F96D448608F272BA004A47F5 /* tclsh.rc */,
				F96D448708F272BA004A47F5 /* tclWin32Dll.c */,
				F96D448808F272BA004A47F5 /* tclWinChan.c */,







<







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
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 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.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>"; };







|







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
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
		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>"; };
		F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = "<group>"; };
		F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = "<group>"; };
		F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = "<group>"; };
		F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = "<group>"; };
		F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = "<group>"; };
		F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; 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>"; };
		F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; 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>"; };







<
<
<
<
<
<


<







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
841
842
843
844
845
846
847
848
		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>"; };
		F96D448008F272BA004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; 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>"; };







<







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
1152
1153
1154
1155
1156
1157
1158
1159
				F96D3E9E08F272A7004A47F5 /* Sleep.3 */,
				F96D3E9F08F272A7004A47F5 /* socket.n */,
				F96D3EA008F272A7004A47F5 /* source.n */,
				F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */,
				F96D3EA208F272A7004A47F5 /* split.n */,
				F96D3EA308F272A7004A47F5 /* SplitList.3 */,
				F96D3EA408F272A7004A47F5 /* SplitPath.3 */,
				F96D3EA508F272A7004A47F5 /* StaticPkg.3 */,
				F96D3EA608F272A7004A47F5 /* StdChannels.3 */,
				F96D3EA708F272A7004A47F5 /* string.n */,
				F96D3EA808F272A7004A47F5 /* StringObj.3 */,
				F96D3EA908F272A7004A47F5 /* StrMatch.3 */,
				F96D3EAA08F272A7004A47F5 /* subst.n */,
				F96D3EAB08F272A7004A47F5 /* SubstObj.3 */,
				F96D3EAC08F272A7004A47F5 /* switch.n */,







|







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
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
			path = tests;
			sourceTree = "<group>";
		};
		F96D43D008F272B8004A47F5 /* tools */ = {
			isa = PBXGroup;
			children = (
				F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
				F96D43D208F272B8004A47F5 /* configure */,
				F96D43D308F272B8004A47F5 /* configure.ac */,
				F96D442508F272B8004A47F5 /* genStubs.tcl */,
				F96D442708F272B8004A47F5 /* index.tcl */,
				F96D442808F272B8004A47F5 /* installData.tcl */,
				F96D442908F272B8004A47F5 /* loadICU.tcl */,
				F96D442A08F272B8004A47F5 /* Makefile.in */,
				F96D442B08F272B8004A47F5 /* makeTestCases.tcl */,
				F96D442C08F272B8004A47F5 /* man2help.tcl */,
				F96D442D08F272B8004A47F5 /* man2help2.tcl */,
				F96D442E08F272B8004A47F5 /* man2html.tcl */,
				F96D442F08F272B8004A47F5 /* man2html1.tcl */,
				F96D443008F272B8004A47F5 /* man2html2.tcl */,
				F96D443108F272B8004A47F5 /* man2tcl.c */,
				F96D443208F272B8004A47F5 /* README */,
				F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
				F96D443508F272B8004A47F5 /* tcl.hpj.in */,
				F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
				F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
				F92D7F100DE777240033A13A /* tsdPerf.tcl */,
				F96D443B08F272B9004A47F5 /* uniClass.tcl */,
				F96D443C08F272B9004A47F5 /* uniParse.tcl */,
			);
			path = tools;







<
<




<

<
<
<
<
<
<


<







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
1747
1748
1749
1750
1751
1752
1753
1754
				F96D447808F272BA004A47F5 /* makefile.vc */,
				F96D447908F272BA004A47F5 /* nmakehlp.c */,
				F96D447A08F272BA004A47F5 /* README */,
				F96D447C08F272BA004A47F5 /* rules.vc */,
				F96D447D08F272BA004A47F5 /* stub16.c */,
				F96D447E08F272BA004A47F5 /* tcl.dsp */,
				F96D447F08F272BA004A47F5 /* tcl.dsw */,
				F96D448008F272BA004A47F5 /* tcl.hpj.in */,
				F96D448108F272BA004A47F5 /* tcl.m4 */,
				F96D448208F272BA004A47F5 /* tcl.rc */,
				F96D448308F272BA004A47F5 /* tclAppInit.c */,
				F96D448408F272BA004A47F5 /* tclConfig.sh.in */,
				F96D448608F272BA004A47F5 /* tclsh.rc */,
				F96D448708F272BA004A47F5 /* tclWin32Dll.c */,
				F96D448808F272BA004A47F5 /* tclWinChan.c */,







<







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
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 (c) 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"






|
|







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
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 (c) 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"







|







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
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 = TclGetStringFromObj(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);







|







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
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 (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright 2001-2009, Apple Inc.
 * Copyright (c) 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"








|
|
|







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
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)) {						\
	Tcl_WideInt s = TclpGetWideClicks(), e;				\
									\
	SpinLockLock(p);						\
	e = TclpGetWideClicks();					\
	TclMacOSXNotifierDbgMsg("waited on %s for %8.0f ns",		\
		#p, TclpWideClicksToNanoseconds(e-s));			\
    }
#undef LOCK_NOTIFIER_INIT







|







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



















































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
#define noCFafterFork	1
#endif /* MAC_OS_X_VERSION_MIN_REQUIRED */
#endif /* HAVE_PTHREAD_ATFORK */

/*
 *----------------------------------------------------------------------
 *



















































 * Tcl_InitNotifier --
 *
 *	Initializes the platform specific notifier state.
 *
 * Results:
 *	Returns a handle to the notifier state for this thread.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
{
    ThreadSpecificData *tsdPtr;

    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    }

    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: pthread_once failed");
    }
#endif

#ifndef __CONSTANT_CFSTRINGS__
    if (!tclEventsOnlyRunLoopMode) {
	tclEventsOnlyRunLoopMode = CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE);
    }







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|













|

|
<
<
<
<
<
<






|







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
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

	bzero(&runLoopSourceContext, sizeof(CFRunLoopSourceContext));
	runLoopSourceContext.info = tsdPtr;
	runLoopSourceContext.perform = QueueFileEvents;
	runLoopSource = CFRunLoopSourceCreate(NULL, LONG_MIN,
		&runLoopSourceContext);
	if (!runLoopSource) {
	    Tcl_Panic("Tcl_InitNotifier: 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: 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: could not create "
		    "CFRunLoopObserver");
	}
	CFRunLoopAddObserver(runLoop, runLoopObserverTcl,
		tclEventsOnlyRunLoopMode);

	tsdPtr->runLoop = runLoop;
	tsdPtr->runLoopSource = runLoopSource;
	tsdPtr->runLoopObserver = runLoopObserver;







|
>











|
|
















|
|







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
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
     * child of a fork.
     */

    if (MayUsePthreadAtfork() && !atForkInit) {
	int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);

	if (result) {
	    Tcl_Panic("Tcl_InitNotifier: 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: 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: 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: could not make trigger pipe non "
		    "blocking");
	}

	receivePipe = fds[0];
	triggerPipe = fds[1];

	/*
	 * Create notifier thread lazily in Tcl_WaitForEvent() to avoid







|












|





|
|




|
|







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
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
    UNLOCK_NOTIFIER_INIT;
    return tsdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMacOSXNotifierAddRunLoopMode --
 *
 *	Add the tcl notifier RunLoop source, observer and timer (if any)
 *	to the given RunLoop mode.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclMacOSXNotifierAddRunLoopMode(
    const void *runLoopMode)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    CFStringRef mode = (CFStringRef) runLoopMode;

    if (tsdPtr->runLoop) {
	CFRunLoopAddSource(tsdPtr->runLoop, tsdPtr->runLoopSource, mode);







|














|







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
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
	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(&notifierThread, &attr,
		(void * (*)(void *))NotifierThreadProc, NULL);
	pthread_attr_destroy(&attr);
	if (result) {
	    Tcl_Panic("StartNotifierThread: unable to start notifier thread");
	}
	notifierThreadRunning = 1;
    }
    UNLOCK_NOTIFIER_INIT;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
 *	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
Tcl_FinalizeNotifier(
    ClientData clientData)
{
    ThreadSpecificData *tsdPtr;

    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    }

    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







|













|















|
|

|
<
<
<
<
<
<
<







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(&notifierThread, &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
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
    }
    UNLOCK_NOTIFIER_TSD;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 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
Tcl_AlertNotifier(
    ClientData clientData)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;

    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    }

    LOCK_NOTIFIER_TSD;
    if (tsdPtr->runLoop) {
	CFRunLoopSourceSignal(tsdPtr->runLoopSource);
	CFRunLoopWakeUp(tsdPtr->runLoop);
    }
    UNLOCK_NOTIFIER_TSD;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimer --
 *
 *	This function sets the current notifier timer value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Replaces any previous timer.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
{
    ThreadSpecificData *tsdPtr;
    CFRunLoopTimerRef runLoopTimer;
    CFTimeInterval waitTime;

    if (tclNotifierHooks.setTimerProc) {
	tclNotifierHooks.setTimerProc(timePtr);
	return;
    }

    tsdPtr = TCL_TSD_INIT(&dataKey);
    runLoopTimer = tsdPtr->runLoopTimer;
    if (!runLoopTimer) {
	return;
    }
    if (timePtr) {
	Tcl_Time vTime = *timePtr;

	if (vTime.sec != 0 || vTime.usec != 0) {
	    tclScaleTimeProcPtr(&vTime, tclTimeClientData);
	    waitTime = vTime.sec + 1.0e-6 * vTime.usec;
	} else {
	    waitTime = 0;
	}
    } else {
	waitTime = CF_TIMEINTERVAL_FOREVER;
    }







|
















|


|
<
<
<
<
<












|













|






<
<
<
<
<









|







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
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
    TCL_UNUSED(ClientData))
{
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
 *
 *	This function is invoked whenever the service mode changes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ServiceModeHook(
    int mode)			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    ThreadSpecificData *tsdPtr;

    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    }

    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();
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	This function registers a file handler with the select notifier.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure.
 *
 *----------------------------------------------------------------------
 */

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. */
{
    ThreadSpecificData *tsdPtr;
    FileHandler *filePtr;

    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	return;
    }

    tsdPtr = TCL_TSD_INIT(&dataKey);

    for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    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;







|













|



|
<
<
<
<
<
<
<



















|

|











|









|
|

<
<
<
<
<
<
<
<
<
<
<
<
<

|







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
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
    }
    UNLOCK_NOTIFIER_TSD;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	Cancel a previously-arranged callback arrangement for a file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered on file, remove it.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    FileHandler *filePtr, *prevPtr;
    int i, numFdBits;
    ThreadSpecificData *tsdPtr;

    if (tclNotifierHooks.deleteFileHandlerProc) {
	tclNotifierHooks.deleteFileHandlerProc(fd);
	return;
    }

    tsdPtr = TCL_TSD_INIT(&dataKey);
    numFdBits = -1;

    /*
     * 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;
	}
	if (filePtr->fd == fd) {
	    break;
	}
    }

    /*
     * 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) {







|













|




|
|
<
<
<
<
<
<
<
<





<
|
|
|
<
<
<
<






|

|



|







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
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
     * 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);
    for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd != fileEvPtr->fd) {
	    continue;
	}

	/*
	 * 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







<
|
|
<
<
<







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
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
	    }
	    if (mask & TCL_EXCEPTION) {
		FD_CLR(filePtr->fd, &tsdPtr->readyMasks.exceptional);
	    }
	    UNLOCK_NOTIFIER_TSD;
	    filePtr->proc(filePtr->clientData, mask);
	}
	break;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	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
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    int result, polling, runLoopRunning;
    CFTimeInterval waitTime;
    SInt32 runLoopStatus;
    ThreadSpecificData *tsdPtr;

    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    }
    result = -1;
    polling = 0;
    waitTime = CF_TIMEINTERVAL_FOREVER;
    tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->runLoop) {
	Tcl_Panic("Tcl_WaitForEvent: Notifier not initialized");







<







|
















|







<
<
<







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
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
	/*
	 * 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) {
	    tclScaleTimeProcPtr(&vTime, tclTimeClientData);
	    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;
	}
    }








|


<










|
|







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
1434
1435
1436
1437
1438
1439
1440
1441

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);







|







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
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

	/*
	 * 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) {







|
>














|
|
















|
>







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
1629
1630
1631
1632
1633
1634
1635
1636
1637

    /*
     * TIP #233: Scale from virtual time to real-time.
     */

    vdelay.sec = ms / 1000;
    vdelay.usec = (ms % 1000) * 1000;
    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);


    if (tsdPtr->runLoop) {
	CFTimeInterval waitTime;
	CFRunLoopTimerRef runLoopTimer = tsdPtr->runLoopTimer;
	CFAbsoluteTime nextTimerFire = 0, waitEnd, now;
	SInt32 runLoopStatus;








<
|







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
1856
1857
1858
1859
1860
1861
1862
1863
 *	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.
 *
 * Side effects:
 *	The trigger pipe used to signal the notifier thread is created when
 *	the notifier thread first starts.
 *
 *----------------------------------------------------------------------
 */







|







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
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102

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;







|
|
|







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
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
    }
}
#endif /* HAVE_PTHREAD_ATFORK */

#else /* HAVE_COREFOUNDATION */

void
TclMacOSXNotifierAddRunLoopMode(
    const void *runLoopMode)
{
    Tcl_Panic("TclMacOSXNotifierAddRunLoopMode: "
	    "Tcl not built with CoreFoundation support");
}

#endif /* HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|


|












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
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 (c) 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]]} {











|







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
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 (c) 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:











|







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
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 (c) 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#


if {![namespace exists ::tclTestPerf]} {











|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# 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 (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2000 by 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 Tcl 8.5-
package require tcltest 2.5
namespace import ::tcltest::*

configure {*}$argv -testdir [file dirname [file dirname [file normalize [
    info script]/...]]]

if {[singleProcess]} {






|
|





<







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

18

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
# 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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain x




test append-1.1 {append command} {
    unset -nocomplain x
    list [append x 1 2 abc "long string"] $x
} {{12abclong string} {12abclong string}}
test append-1.2 {append command} {
    set x ""
    list [append x first] [append x second] [append x third] $x
} {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} {set i [expr $i+1]} {
	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-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 ""






|
|
|








>

>

>
>















|




















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
161
162
163
164
165
166
167
168
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} {set i [expr $i+1]} {
	    set j [lindex $var $i]
	    if {$j ne "item $i"} {
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }







|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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} {set i [expr $i+1]} {
	    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}







|







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
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} {set i [expr $i+1]} {
	lappend x "item $i"
    }
    check $x 300
} -cleanup {
    unset -nocomplain x
    catch {rename check ""}
} -result ok







|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 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::*






|
|
|
|







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
5
6
7
8
9
10
11
12
13
# assemble.test --
#
#	Test suite for the 'tcl::unsupported::assemble' command
#
# Copyright (c) 2010 by Ozgur Dogan Ugurlu.
# Copyright (c) 2010 by Kevin B. Kenny.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#-----------------------------------------------------------------------------

# Commands covered: assemble





|
|







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
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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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






|
|
|










|







1
2
3
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
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 (c) 1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testasync [llength [info commands testasync]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

proc async1 {result code} {
    global aresult acode
    set aresult $result
    set acode $code
    return "new result"
}






|
|
|










|


|







1
2
3
4
5
6
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
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 (c) 1998  Lucent Technologies, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*





|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# 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
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 (c) 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"}







|







|
|







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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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}











|
|










|







1
2
3
4
5
6
7
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
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 {}
}








|







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
7
8
9
10
11
12
13
14
15
16



17
18
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
# 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 (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}



testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
testConstraint testbytestring [llength [info commands testbytestring]]

# Big test for correct ordering of data in [expr]
proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
	    # little endian
	    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
	}






|
|








>
>
>











|

|









|

|

|





|

|









|

|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
    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}








|


|


|


|







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
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
    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\00\00
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 {







|


|


|


|


















|


|


|


|


|







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
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
    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 {







|


|


|


|


|







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
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
    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"







|


|


|


|


|


|


|


|


|


|
















|



|












|


|


|


|


|


|


|


|










|



|







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
762









763
764
765
766
767
768
769
    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-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}







|
>
>
>
>
>
>
>
>
>







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
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
} -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







|



|











|







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
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
} -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







|



|











|







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
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
} {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}







|



|



|



|



|



|




















|



|



|



















|



|



|



|



|
















|



|





|





|







|



|



|



|



|
















|



|



|







|



|



|



|



|
















|



|



|











|



|



|



|



|
















|



|



|











|



|



|



|



|



|



|



|



|



|










|





|





|







|



|



|



|



|



|



|



|



|



|










|





|





|







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
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
    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}







|


|


|


|



|



















|




















|



|







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
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
    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







|




|




|




|







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
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
} {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* \u20ac
} \u00ac
test binary-46.2 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    list [binary scan [binary format a* \u20ac\u20bd] 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* \u20ac\u20bd] aaa x y z] $x $y $z
} "2 \u00ac \u00bd {}"
test binary-46.4 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    set x [encoding convertto iso8859-15 \u20ac]
    set y [binary format a* $x]
    list $x $y
} "\u00a4 \u00a4"
test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    set x [binary scan \u00a4 a* y]
    list $x $y [encoding convertfrom iso8859-15 $y]
} "1 \u00a4 \u20ac"

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







|
|

|





|
|

|


|

|

|







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
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
    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:]]+\))?}







|


|


|


|


|


|


|


|










|



|













|


|


|


|


|


|


|


|


|


|
















|



|







|



|



|



|



|
















|




















|



|



|



|



|
















|




















|



|



|



|



|
















|




















|



|



|



|



|
















|




















|



|



|



|



|



|



|



|



|



|










|





|





|








|



|



|



|



|



|



|



|



|



|










|





|





|







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
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
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 \0\1\2\3\4\0\1\2\3\4
} -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 "\0\1\2\3\4\0\1\2\3\4"
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 {







|
















|







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
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
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 \0\1\2\3\4\0\1\2\3
} -result {AAECAwQAAQID}
test binary-72.6 {binary encode base64} -body {
    binary encode base64 \0
} -result {AA==}
test binary-72.7 {binary encode base64} -body {
    binary encode base64 \0\0
} -result {AAA=}
test binary-72.8 {binary encode base64} -body {
    binary encode base64 \0\0\0
} -result {AAAA}
test binary-72.9 {binary encode base64} -body {
    binary encode base64 \0\0\0\0
} -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}







|


|


|


|


|







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
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
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 "\0\1\2\3\4\0\1\2\3"
test binary-73.6 {binary decode base64} -body {
    binary decode base64 AA==
} -result "\0"
test binary-73.7 {binary decode base64} -body {
    binary decode base64 AAA=
} -result "\0\0"
test binary-73.8 {binary decode base64} -body {
    binary decode base64 AAAA
} -result "\0\0\0"
test binary-73.9 {binary decode base64} -body {
    binary decode base64 AAAAAA==
} -result "\0\0\0\0"
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







|
















|


|


|


|


|







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
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
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 \0\1\2\3\4\0\1\2\3
} -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 \0\0
} -result "\"```
"
test binary-74.8 {binary encode uuencode} -body {
    binary encode uuencode \0\0\0
} -result {#````
}
test binary-74.9 {binary encode uuencode} -body {
    binary encode uuencode \0\0\0\0
} -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







|






|



|



|







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
2836
2837
2838
2839
2840
2841
2842
2843
    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 "\0\1\2\3\4\0\1\2\3"
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 {







|







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
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
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 \u0141 B C] 1
} A

test binary-80.1 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
    testbytestring "\u4E4E"
} -result "expected byte sequence but character 0 was '\u4E4E' (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 '\u4E4E' (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 '\u4E4E' (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:







|



|
|


|


|













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
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 (c) 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::*




|







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
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 \u0100
} -returnCodes error -match glob -result {bad value*}
test chan-4.3 {chan command: [Bug 800753]} -body {
    chan configure stdout -eofchar \u0000
} -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:*}







|


|







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
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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*








|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
39
40
41
42
43
44
45
46
47
48
49

50
51
52
53
54
55
56
57
    variable n
    variable v
    variable msg
    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    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 knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
    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







|
|









>
|







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
81
82
83
84
85
86
87
88
    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







|







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
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
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\u4e4d\0"
    chan close $f
    contents $path(test1)
} "a\x4d\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\u4e4d\0"
    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







|


|



|


|












|







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
275
276
277
278
279
280
281
282
283
284
285
286
287
288
    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 \uff21 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 \uff21 plus the all of \uff22) appended.
    set f [open $path(test1) w]
    chan configure $f -encoding shiftjis -buffersize 16
    chan puts -nonewline $f "12345678901234\uff21\uff22"
    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







|


|


|







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  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  plus the all of ) 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
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
    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\0"
    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 "\u4e00\u4e01"]
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







|










|






|







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
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
    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\u001abat"
    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]







|


|






|


|







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
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
    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 ""







|

















|







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
921
922
923
924
925
926
927
928
    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]







|







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
987
988
989
990
991
992
993
994
995
996
997
} -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]







|


|







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
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
} -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\u4e00ok\n\u4e01more 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\u4e00ok" 11 "\u4e01more 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"







|






|







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 "thereok\nmore 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 "thereok" 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
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
    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 "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding shiftjis -buffersize 16
    chan gets $f
} -cleanup {
    chan close $f
} -result "1234567890123\uff10\uff11\uff12\uff13\uff14"
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 "1234567890123\uff10\uff11" 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 "1234567890123\uff10\uff11\uff12\uff13" 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







|






|




|












|








|





|












|







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
1207
1208
1209
1210
1211
1212
1213
1214
} -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 {
} {}







|







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
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
    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 "\u672c" 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
	}







|






|





|

|







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
1403
1404
1405
1406
1407
1408
1409
1410
    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 \u7266 {} 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)]







|







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
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
    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 != '\0')
    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 != '\0')
    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







|











|







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
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
    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 knownMsvcBug} -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







|








|







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
2799
2800
2801
2802
2803
2804
2805
2806
    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 knownMsvcBug} -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} {







|







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
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
    }
    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







|
















|







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
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
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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation lf
    chan puts $f hello\nthere\nand\rhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation auto
    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]







|


|












|



|

















|




















|







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
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
    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.







|











|

















|














|













|













|













|













|













|







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
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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation lf
    chan puts $f hello\nthere\nand\rhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    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 -eofchar \x1a
    chan configure $f -translation auto
    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 -eofchar \x1a -translation auto
    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







|















|



|



















<
|

















|







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
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]







|







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
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]







|







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
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







|









|

















|

















|

















|

















|

















|







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
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} {







|



















|







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
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








|




|








|




|








|




|








|




|








|




|








|




|













|













|













|













|













|













|







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
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 \u7266
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 \u7266
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







|






|





|






|













|

















|







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
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} 0600]
    file stat $path(test3) stats
    set x [format "%#o" [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 "%#o" [expr $stats(mode)&0o777]
} -result [format %#5o [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







|

|













|
|







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
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\0ipt"
    lappend result [string length [chan event $f readable]]
    chan event $f r "new scr\0ipt"
    lappend result [string length [chan event $f readable]]
    chan event $f r "yet ano\0ther"
    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 {}







|

|

|







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
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







|







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
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 -eofchar \x1a -translation auto
    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
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
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







|







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
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 -eofchar \x1a -translation auto
    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
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
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







|







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
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 -eofchar \x1a -translation auto
    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
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
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 -eofchar \x1a -translation lf
    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
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
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







|







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
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 -eofchar \x1a -translation cr
    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
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
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







|







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
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 -eofchar \x1a -translation crlf
    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
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
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







|







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
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 [test servicemode 1]
	    vwait z
	    after cancel $timer
	    test servicemode $mode
	    lappend z "del after update"
	}
    }
    set z ""
    set u toplevel
    set timer [after 50 lappend z timeout]
    testservicemode 0







|


|







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
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







|







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
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 "\u0410\u0410"
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







|







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
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 "\u0410\u0410"
    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







|







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
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







|



















|







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
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 {







|







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
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]







|







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
9
10
11
12
13
14
15
16
# clock.test --
#
#	This test file covers the 'clock' command that manipulates time.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*








|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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} } {







|







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
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}}







|












|




















|















|







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
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]







|







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
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 \u897f\u66a61872\u5e7412\u670831\u65e5
	    1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5
	    1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5
	    1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5
	    1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5
	    1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5
	    1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5
	    1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5
	    2019-04-30 \u5e73\u621031\u5e7404\u670830\u65e5
	    2019-05-01 \u4ee4\u548c01\u5e7405\u670801\u65e5
	} {
	    set status [catch {
		set secs [clock scan $date \
			      -timezone +0900 \
			      -locale ja_JP \
			      -format %Y-%m-%d]
		set jda [clock format $secs \







|
|
|
|
|
|
|
|
|
|







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 西暦18721231
	    1873-01-01 明治060101
	    1912-07-29 明治450729
	    1912-07-30 大正01年0730
	    1926-12-24 大正151224
	    1926-12-25 昭和011225
	    1989-01-07 昭和640107
	    1989-01-08 平成010108
	    2019-04-30 平成310430
	    2019-05-01 令和010501
	} {
	    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
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]







|


|







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
7
8
9
10
11
12
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 (c) 1996-1998 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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 {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

proc waitForEvenSecondForFAT {} {
    # Windows 9x uses filesystems (the FAT* family of FSes) without enough






|
|










|









|







1
2
3
4
5
6
7
8
9
10
11
12
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
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 .\0
} -cleanup {
    cd $dir
} -match glob -result "couldn't change working directory to \".\0\": *"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
    concat
} {}
test cmdAH-2.8 {Tcl_ConcatObjCmd} {
    concat a
} a
test cmdAH-2.9 {Tcl_ConcatObjCmd} {







|


|







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
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 \u4e4e
} -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 \u4e4e
} -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 \u4e4e
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 \u4e4e
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 {







|







|
















|







|







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
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 0000
    file exists /tmp/tcl.foo.dir/file
} -cleanup {
    file attributes /tmp/tcl.foo.dir -permissions 0775
    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







|


|







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
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 0765}

# 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]
}







|







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
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)&0777] $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







|







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
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 \u2022
    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"}







|







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
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 \u2022
    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"}







|







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
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 0765}

# 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







|







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
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
    expr {$stat(mode) & 0o777}
} -result {501}
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







|
|







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
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 0777}
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:







|













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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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::*





|
|











|







1
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
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 \0 \x7f \x80 \uffff]
} [list \0 \x7f \x80 \uffff]
test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii -nocase [list \0 \x7f \x80 \uffff]
} [list \0 \x7f \x80 \uffff]
test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii [list \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \x7f \x80 \uffff \U01ffff]
test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \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}]
	}







|
|

|
|

|
|

|
|















|







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
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 \xe3 \xc4"]
    ::tcltest::restore_locale
    set result
} "A a B b C c \xe3 \xc4"
test cmdIL-4.25 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
    ::tcltest::set_iso8859_1_locale
    set result [lsort -dictionary "a23\xe3 a23\xc5 a23\xe4"]
    ::tcltest::restore_locale
    set result
} "a23\xe3 a23\xe4 a23\xc5"
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} {







|


|


|


|







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
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\u0000a 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\u0000a]] %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}







|


|







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
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}}







|







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
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 (c) 1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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








|
|
|










|







1
2
3
4
5
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 000
    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







|







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
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\000c
        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\000c4" ab\000c
} {{} 0 {} 1 2 {} {} 3 {} 4}
test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
    # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
    split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
} "a b qw\u5e4eN 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):







|






|


|
|
|







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 "ab qw幎N wq" " "
} "a b qwN 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
9
10
11
12
13
14
15
16
17
18
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 (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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
	}








|
|




















|

|









|

|

|





|

|









|

|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*




|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
# 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
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*}







|








|







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
373



































374
375
376

377
378
379
380
381
382
383
        set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    unset end i tmp
    rename getbytes {}
} -result 0




































# cleanup
catch {unset a}
catch {unset b}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



>







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
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 (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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.







|
|











|







1
2
3
4
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
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} {







|







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
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 \000foo" msg] $msg
} {0 4}
test compile-8.2 {CollectArgInfo: binary data} {
    list [catch "string length foo\000" 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 {} {







|







|


|







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
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 !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







|







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
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 {}
}








|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test pkgconfig-1.1 {query keys} {
    lsort [::tcl::pkgconfig list]
} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime}
test pkgconfig-1.2 {query keys multiple times} {
    string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
test pkgconfig-1.3 {query value multiple times} {
    string compare \
	    [::tcl::pkgconfig get bindir,install] \
	    [::tcl::pkgconfig get bindir,install]







|
|
|









|

|







1
2
3
4
5
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
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 (c) 2008 by 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 Tcltest [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






|










|







1
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
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 (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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 {






|
|
|










|







1
2
3
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
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 (c) 2003-2009 Donal K. Fellows
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testdstring [llength [info commands testdstring]]
if {[testConstraint testdstring]} {
    testdstring free
}

test dstring-1.1 {appending and retrieving} -constraints testdstring -setup {






|
|
|










|







1
2
3
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
5
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

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 Tcltest [info patchlevel]
}

proc toutf {args} {
    variable x
    lappend x "toutf $args"
}
proc fromutf {args} {




|
|















|







1
2
3
4
5
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
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 \u4e4e] \
	[encoding convertfrom jis0208 8C]
} "8C \u4e4e"

test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
    encoding convertto jis0208 \u4e4e
} {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 \u4e4e]	;# old one found
    encoding system iso8859-1
    llength shiftjis		;# Shimmer away any cache of Tcl_Encoding
    lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
} -cleanup {
    encoding system iso8859-1
    encoding dirs $path
    encoding system $system
} -result "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"

test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup {
    set old [encoding system]
} -body {
    encoding system shiftjis
    encoding system
} -cleanup {







|

|


|







|


|




|







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
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 \u4e4e
} -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







|







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
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
    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
} "\u543e\u543e\u543e\u543e"
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 \u4e4e"

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\u4e4eg"

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
    encoding convertto jis0208 "\u543e\u543e\u543e\u543e"
} {8c8c8c8c}
test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
    set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e
    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\u4e4eg"
    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 \u4e4e} msg] $msg]
    encoding dirs $path
    encoding system $system
    lappend x [encoding convertto jis0208 \u4e4e]
} {1 {unknown encoding "jis0208"} 8C}
test encoding-11.2 {LoadEncodingFile: single-byte} {
    encoding convertfrom jis0201 \xa1
} "\uff61"
test encoding-11.3 {LoadEncodingFile: double-byte} {
    encoding convertfrom jis0208 8C
} "\u4e4e"
test encoding-11.4 {LoadEncodingFile: multi-byte} {
    encoding convertfrom shiftjis \x8c\xc1
} "\u4e4e"
test encoding-11.5 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022 \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022-jp \u4e4e]
} [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 \u4e4e
} -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"}






# 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 \u0120]
    append x [encoding convertto iso8859-3 \xD5]
    append x [encoding convertfrom iso8859-3 \xD5]
} "\xd5?\u120"
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
    set x [encoding convertto iso8859-3 ab\u0120g]
    append x [encoding convertfrom iso8859-3 ab\xD5g]
} "ab\xd5gab\u120g"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
    set x [encoding convertto shiftjis ab\u4E4Eg]
    append x [encoding convertfrom shiftjis ab\x8c\xc1g]
} "ab\x8c\xc1gab\u4e4eg"
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
    set x [encoding convertto jis0208 \u4e4e\u3b1]
    append x [encoding convertfrom jis0208 8C&A]
} "8C&A\u4e4e\u3b1"
test encoding-12.5 {LoadTableEncoding: symbol encoding} {
    set x [encoding convertto symbol \u3b3]
    append x [encoding convertto symbol \u67]
    append x [encoding convertfrom symbol \x67]
} "\x67\x67\u3b3"

test encoding-13.1 {LoadEscapeTable} {
    viewable [set x [encoding convertto iso2022 ab\u4e4e\u68d9g]]
} [viewable "ab\x1b\$B8C\x1b\$\(DD%\x1b(Bg"]

test encoding-15.1 {UtfToUtfProc} {
    encoding convertto utf-8 \xa3
} "\xc2\xa3"
test encoding-15.2 {UtfToUtfProc null character output} testbytestring {
    binary scan [testbytestring [encoding convertto utf-8 \u0000]] H* z
    set z
} 00
test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
    set y [encoding convertfrom utf-8 [encoding convertto utf-8 \u0000]]
    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 \U1F602"
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 \U1F602"
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\xE9
    set y [encoding convertto utf-8 \uDE02\uD83D\xE9]
    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\xE9
    set y [encoding convertto utf-8 \uDE02\xE9]
    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\xE9
    set y [encoding convertto utf-8 \uDA02\xE9]
    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







|








|




|







|


|


|













|







|







|











|


|


|
|


|

|
|

|
|

|
|













|








|
>
>
>
>
>



|
|
|
|

|
|
|

|
|
|

|

|

|
|
|
|


|
|


|
|

|



|







|




|













|
|










|
|




|
|







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
} "abg"

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 "abg"
    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 abg]
    append x [encoding convertfrom shiftjis ab\x8C\xC1g]
} "ab\x8C\xC1gabg"
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
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
} {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 \U1F602
    set y [encoding convertto utf-8 \U1F602]
    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 "\u4E4E 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 "\u4E4E 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"







|
|







|











|







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
457
458
459
460
461
462
463
464
465
466


467
468

469
470
471
472
473
474
475

test encoding-21.1 {EscapeToUtfProc} {
} {}

test encoding-22.1 {EscapeFromUtfProc} {
} {}

set iso2022encData "\u001b\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\u001b(B
\u001b\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\u001b(B
\u001b\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\u001b(B
casino_japanese@___.com \u001b\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\u001b(B
\u001b\$B\$7\$g\$&\$+!)\u001b(B"

set iso2022uniData [encoding convertfrom iso2022-jp $iso2022encData]
set iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3054\u8cfc\u5165\u6642\u306b\u3054\u767b\u9332\u3044\u305f\u3060\u3044\u305f\u3054\u4f4f\u6240\u3092\u30ad\u30e3\u30c3\u30b7\u30e5\u30a2\u30a6\u30c8\u306e\u969b\u306e
\u5c0f\u5207\u624b\u9001\u4ed8\u5148\u3068\u3057\u3066\u4f7f\u7528\u3057\u3066\u304a\u308a\u307e\u3059\u3002\u6050\u308c\u5165\u308a\u307e\u3059\u304c\u3001\u6b63\u3057\u3044\u4f4f\u6240\u3092\u3054\u767b\u9332\u3057\u306a\u304a
\u304a\u9858\u3044\u3044\u305f\u3057\u307e\u3059\u3002\u307e\u305f\u3001\u5927\u5909\u6050\u7e2e\u3067\u3059\u304c\u3001\u4f4f\u6240\u5909\u66f4\u306e\u3042\u3068\u3001\u65e5\u672c\u8a9e\u30b5\u30fc\u30d3\u30b9\u90e8\uff08


\u0063\u0061\u0073\u0069\u006e\u006f\u005f\u006a\u0061\u0070\u0061\u006e\u0065\u0073\u0065\u0040\u005f\u005f\u005f\u002e\u0063\u006f\u006d\u0020\uff09\u307e\u3067\u3054\u4f4f\u6240\u5909\u66f4\u6e08\u306e\u9023\u7d61\u3092\u3044\u305f\u3060\u3051\u306a\u3044\u3067
\u3057\u3087\u3046\u304b\uff1f"


cd [temporaryDirectory]
set fid [open iso2022.txt w]
fconfigure $fid -encoding binary
puts -nonewline $fid $iso2022encData
close $fid








|
|
|
|
|


|
<
<
>
>
|
<
>







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
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
    }
} {}
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\u4e4e\u68d9g
	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 "\u4e4e\u4e5e\u4e5f"; # 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 (\\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
#







|



|





|








|


|


|


|


|


|


|


|


|







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
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
	} 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} {







|



|





|
|

|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact Tcltest [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






|
|
|










|







1
2
3
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
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
    __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]] {







|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2.5
namespace import -force ::tcltest::*

catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}


testConstraint testfilehandler [llength [info commands testfilehandler]]
testConstraint testexithandler [llength [info commands testexithandler]]
testConstraint testfilewait [llength [info commands testfilewait]]
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
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
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35
36
# 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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# 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 Tcltest [info patchlevel]]
package require tcltests

# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]

testConstraint noosx [expr {![info exists ::env(TRAVIS_OSX_IMAGE)] || ![string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]

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] {






|
|
|













|





>
|







1
2
3
4
5
6
7
8
9
10
11
12
13
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
115
116
117
118
119
120
121
122
	    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 {







|







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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
    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 "\[\u007f-\uffff\]" $s \
	    {[apply {c {format {\u%04x} [scan $c %c]}} &]} s
	return [subst -novariables $s]
    }
} -constraints {exec} -body {
    # If this fails, it may give back: "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1"
    # If it does, this means that the UTF -> external conversion did not occur
    # before writing out the temp file.
    quotenonascii [exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"]
} -cleanup {
    encoding system $sysenc
    rename quotenonascii {}
} -result {\u00e9\u00e0\u00fc\u00f1}

# 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} {







|
|



|


|



|







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


676
677
678
679
680
681
682
683
} -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...


test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosx} -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 \







>
>
|







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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
catch {unset x}
catch {unset y}
catch {unset msg}











|
|










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
# 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
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







|


|


|


|


|


|


|


|


|


|


|


|


|


|


|







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
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 Tcltest [info patchlevel]]
	::tcltest::loadTestedCommands
	if {[namespace which -command testbumpinterpepoch] eq ""} {
	  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
	}
    }
} -body {
    child eval {







|







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
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 Tcltest [info patchlevel]]
	::tcltest::loadTestedCommands
	if {[namespace which -command testbumpinterpepoch] eq ""} {
	  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
	}
    }
} -body {
    set res {}







|







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
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]}} \u0130
} {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} ;#}







|







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
9
10
11
12
13
14
15
16
17
18
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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by 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 Tcltest [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
	}








|
|
|










|















|

|









|

|

|





|

|









|

|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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 "/"}}







|







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
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 (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by 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::*






|
|







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
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
	}







|

|









|

|

|

|





|

|









|

|

|

|







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
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 \u00fc]}} 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 {







|







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
7
8
9
10
11
12
13
14
15
16
17
18
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
# 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 (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

cd [temporaryDirectory]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
testConstraint winXP 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 notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

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 {






|
|










|





|
<

















|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81

82
83
84
85
86
87
88

    if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) >= 5.0} {
	testConstraint winVista 1
    } else {
	testConstraint winXP 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 fileSharing 0
testConstraint notFileSharing 1
testConstraint linkFile 1
testConstraint linkDirectory 1

# Several tests require need to match results against the unix username







|
<
|
<
<
<








>







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
278
279
280
281
282
283
284
285
} -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] == '\0'} -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







|







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
320
321
322
323
324
325
326
327
    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 == '\0'} -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 {







|







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
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
    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 0000
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1 -permissions 0755
    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 0000
    file copy ~/td1 td1
} -returnCodes error -cleanup {
    file attributes $td1name -permissions 0755
    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 0000
    file copy td2 ~/td1
} -returnCodes error -cleanup {
    file attributes $td1name -permissions 0755
    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 0000
    file copy ~/td1 td1
} -returnCodes error -cleanup {
    file attributes $td2name -permissions 0755
    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 0000
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1/td2/td3 -permissions 0755
    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







|


|







|


|








|


|







|


|














|


|







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
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
    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.a {file rename: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {win winXP testchmod} -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.4.b {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.a {file rename: comprehensive: dir to self} -setup {
    cleanup
} -constraints {win winXP testchmod} -body {
    file mkdir td1
    file mkdir td2
    testchmod 0o555 td2
    file rename -force td1 .
    file rename -force td2 .
    list [lsort [glob td*]] [file writable td1] [file writable td2]
} -result {{td1 td2} 1 0}
test fCmd-9.6.b {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 .







|
<
<
<
<
<
<
<
<
<
<
<




















|
<
<
<
<
<
<
<
<
<
<







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
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
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]
    if {!([testConstraint unix] || [testConstraint winVista])} {
	testchmod 0o555 tds2
    }
    set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
    set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
    if {[testConstraint unix] || [testConstraint winVista]} {
	set w2 0
    } else {
	set w2 [file writable tds2]
    }
    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







<
<
<


<
|
<
<
<







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
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
} -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
    if {!([testConstraint unix] || [testConstraint winVista])} {
	testchmod 0o555 td2
    }
    file rename td1 [file join td3 td3]
    file rename td2 [file join td3 td4]
    if {[testConstraint unix] || [testConstraint winVista]} {
        set w4 0
    } else {
	set w4 [file writable [file join td3 td4]]
    }
    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]







<
<
<


<
|
<
<
<







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
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
    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 0555
    catch {file rename tfa/dir tfa2}
} -cleanup {
    catch {file attributes tfa -permissions 0777}
    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







|


|







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
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
} -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 0000
    catch {file copy tfa tfa2}
} -cleanup {
    file attributes tfa/dir -permissions 0777
    file delete -force tfa tfa2
} -result {1}

#
# Coverage tests for TclMkdirCmd()
#
test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {







|


|







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
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
    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 0000
    catch {file mkdir tfa/file}
} -cleanup {
    file attributes tfa -permissions 0777
    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







|


|







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
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
    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 0555
    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 0777
    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







|







|







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
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
} -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 0555
     catch {file mkdir tfa1/tfa2}
} -cleanup {
     file attributes tfa1 -permissions 0777
     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







|


|







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
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
    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 0555
    catch {file delete tfa/a}
} -cleanup {
    file attributes tfa -permissions 0777
    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







|


|







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
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
# 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 0000
    catch {file delete -force tfa}
} -cleanup {
    file attributes tfa/a -permissions 0777
    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} {







|


|







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

2356
2357
2358
2359
2360

2361
2362
2363
2364
2365
2366
2367
2368
2369
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}

test fCmd-28.8 {file link} -constraints {linkFile win} -setup {
    cd [temporaryDirectory]
} -body {
    file link -symbolic abc.link abc.file
} -returnCodes error -cleanup {

    cd [workingDirectory]
} -result {could not create new link "abc.link" pointing to "abc.file": not a directory}
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]







>
|



|
>

|







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


2584
2585
2586
2587
2588
2589
2590
2591
    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}


test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notWine} -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
    }







>
>
|







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
7
8
9
10
11
12
13
14
15
16
17
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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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 {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
# 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}
}}}






|
|











|













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
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] 0] -tails *]
    }
    catch {
	cd [lindex [file volumes] 0]
	set res2 [glob *]
    }
    list $res1 $res2
} -cleanup {
    cd $tmpd
} -match compareWords -result equal
test filename-11.46 {Tcl_GlobCmd} -returnCodes error -body {







|


|







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
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 0000}
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 0755}
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} {







|











|







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
7
8
9
10
11
12
13
14
15
16
17
18
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
# 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 (c) 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 Tcltest [info patchlevel]
    set ::ddever [package require dde]
    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]
    set ::regver  [package require registry]
    set ::reglib [lindex [package ifneeded registry $::regver] 1]
    testConstraint loaddll 1
}

# Test for commands defined in Tcltest executable
testConstraint testfilesystem  	    [llength [info commands ::testfilesystem]]
testConstraint testsetplatform 	    [llength [info commands ::testsetplatform]]
testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]]


testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

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]







|




















|

|

|
|


|



>
>
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
168
169
170
171
172
173
174
175
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







|







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
319
320
321
322
323
324
325
326
} 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 knownMsvcBug} -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 {







|







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
568
569
570
571
572
573
574
575
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 {







|







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
695
696
697
698
699
700
701
702
    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 0000
    # 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]







|







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
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 (c) 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 \u767b\u9e1b\u9d72\u6a13

    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]


|












|







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
9
10
11
12
13
14
15
16
17
18
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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} {set i [expr $i+1]} {
	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} {set i [expr $i+1]} {
	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} {set i [expr $i+1]} {
	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} {set i [expr $i+1]} {}
    set a
} xyz
test for-old-1.9 {for tests} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]; if $i==4 break} {
	set a [concat $a $i]
    }
    set a
} {1 2 3}

# cleanup
::tcltest::cleanupTests
return








|
|














|






|
|






|
|
















|




|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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 (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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# 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
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} {set i [expr $i+1]} {
	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} {set i [expr $i+1]} "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} {set i [expr $i+1]} $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} {set i [expr $i+1]} {
	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







|
|






|










|










|
|
|







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
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} {set i [expr $i+1]} {
	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} {set i [expr $i+1]} {
	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} {set i [expr $i+1]} {
	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







|














|







|

















|
|
|
|







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
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} {set i [expr $i+1]} {
	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







|
|
|
|















|







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
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







|







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
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







|




|










|







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
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







|







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
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} {set i [expr $i+1]} {
	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} {set i [expr $i+1]} "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} {set i [expr $i+1]} $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} {set i [expr $i+1]} {
	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







|
|







|











|















|
|
|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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







|







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
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:  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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 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}]



testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

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}






|
|














>
>
>
|







1
2
3
4
5
6
7
8
9
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
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\0def
} "   abc\0def"
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} {







|
|

|
|

|
|

|
|







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
148
149
150
151
152
153
154
155
156
} {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} {
    format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xa2 0x4e4e 0x25a 0xc3 0xff08 0 3 0x6575 -4 0x4e4f
} "|\ua2|\u4e4e|\u25a|\uc3|\uff08     |     \0|  \u6575|\u4e4f   |"

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}







>
>
>
>
>
>





|
|







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
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
    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}








|


|






|


|







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
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
    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} {







|










|








|








|








|







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
543
544
545
546
547
548
549
550

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







|







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
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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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 {






|
|










|







1
2
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
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 " " 0_07 " " 0o_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 7 8 {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:







|



|








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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 {







|







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
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
    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]} {







|



|










|









|
>
>







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
219
220
221
222
223
224
225
226

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"







|







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
265
266
267
268
269
270
271
272
	    # 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]
    }







|







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
291
292
293
294
295
296
297
298
	    # 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]
    }







|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by 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::*






|
|
|







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
41
42

43
44
45
46
47
48
49
50
51
52
53
54
55
proc bgerror {args} {
    global errorInfo
    puts stderr "http.test bgerror"
    puts stderr [join $args]
    puts stderr $errorInfo
}

if {$::tcl_platform(os) eq "Darwin"} {
    # Name resolution often a problem on OSX; not focus of HTTP package anyway

    set HOST localhost
} else {
    set HOST [info hostname]
}

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]} {







|
|
>
|
<
<
<
<
|







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
127
128
129
130
131
132
133
134
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>







|







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
626
627
628
629
630
631
632
633
634
635
636
637
638
    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 \xa1\xa2\xa2
} {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 \xa1\xa2\xa2]
    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]







|




|







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
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

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 "\u2208"
} {%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 "\u2208"
} -cleanup {
    http::config -urlencoding $enc
} -result "can't read \"formMap(\u2208)\": 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 "\u2208"
} -cleanup {
    http::config -urlencoding $enc
} -result {%3F}

package require tcl::idna 1.0

test http-idna-1.1 {IDNA package: basics} -returnCodes error -body {







|






|


|






|







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
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
    ::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\u20acb\u20acc
} 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\u20ACB\u20ACC
} 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\u20ACB\u20ACC 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\u20ACB\u20ACC 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\u20ACb\u20ACc 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\u20ACb\u20ACc 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







|





|





|





|





|





|







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 abc
} 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 ABC
} 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 ABC 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 ABC 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 abc 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 abc 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
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
} {-> $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\u20acb\u20acc
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\u20ACB\u20ACC
test http-idna-3.5 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB
} A\u20ACB\u20ACC
test http-idna-3.6 {puny decode: functional test} {
    ::tcl::idna puny decode abc-K50AB
} a\u20ACb\u20ACc
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\u20ACb\u20ACc
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\u20ACB\u20ACC
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\u20ACb\u20ACc
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\u20ACB\u20ACC
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 "!"}







|





|


|


|





|





|





|





|







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
} abc
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
} ABC
test http-idna-3.5 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB
} ABC
test http-idna-3.6 {puny decode: functional test} {
    ::tcl::idna puny decode abc-K50AB
} abc
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
} abc
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
} ABC
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
} abc
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
} ABC
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
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
} {-> $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\u20acb\u20acc.def
} xn--abc-k50ab.def
test http-idna-4.3 {IDNA encoding} {
    ::tcl::idna encode def.a\u20acb\u20acc
} 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\u20acB\u20acC.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







|


|





|







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 abc.def
} xn--abc-k50ab.def
test http-idna-4.3 {IDNA encoding} {
    ::tcl::idna encode def.abc
} 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 ABC.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
1090
1091
1092
1093
1094
1095
1096
1097
} -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\u00e9.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







|







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
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:  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 (c) 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 notOSXtravis [apply {{} {
    upvar 1 env(TRAVIS_OSX_IMAGE) travis
    return [expr {![info exists travis] || ![string match xcode* $travis]}]
}}]
testConstraint sqlite3 [expr {[testConstraint notOSXtravis] && ![catch {
    package require sqlite3
}]}]
testConstraint cookiejar [expr {[testConstraint sqlite3] && ![catch {
    package require cookiejar
}]}]

set COOKIEJAR_VERSION 0.2.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
# 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
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
# -*- tcl -*-
#
# The httpd_ procedures implement a stub http server.
#
# Copyright (c) 1997-1998 Sun Microsystems, Inc.
# Copyright (c) 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

if {$::tcl_platform(os) eq "Darwin"} {
    # Name resolution often a problem on OSX; not focus of HTTP package anyway

    set HOST localhost
} else {
    set HOST [info hostname]
}

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]




|
|






|
|
>
|
<
<
<







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
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 8.6-

proc ::tcl::dict::get? {dict key} {
    if {[dict exists $dict $key]} {
        return [dict get $dict $key]
    }
    return
}










|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*








|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a z







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a z







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







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
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]
		}
		set i [expr $i-1]
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a z







|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*








|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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}




|
|










|







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
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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 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 Tcltest [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}








|
|
|
|











|







1
2
3
4
5
6
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
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}}}}}}







|







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
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}







|







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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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, \u20ac, 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







|







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
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 (c) 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






|







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
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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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






|
|










|







1
2
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
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







|








|







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
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"}








|





|


|





|







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
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.







|







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
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} {







|







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
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







|







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
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 {}
}







|
|







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
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 {}
}







|







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
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







|


















|







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
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}







|














|







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
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
	    }
	}







|
|







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
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
	    }
	}







|
|







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
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
} -returnCodes error -result {seconds must be at least 0}
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
} -returnCodes error -result {milliseconds must be at least 0}
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}







|











|







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
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}







|
|







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
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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
}








|
|
|







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
34
35
36
37
38
39
40
41
42
43
44
45



46
47
48
49
50
51
52
53
    variable n
    variable v
    variable msg
    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    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]]



testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
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







|
|










>
>
>
|







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
77
78
79
80
81
82
83
84
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







|







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
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
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\u4e4d\0"
    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\u4e4d\0"
    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.








|


|



|


|













|







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
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
    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 \uff21 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 \uff21 plus the all of \uff22) appended.

    set f [open $path(test1) w]
    fconfigure $f -encoding shiftjis -buffersize 16
    puts -nonewline $f "12345678901234\uff21\uff22"
    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







|


|



|







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  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  plus the all of ) 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
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
    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\0"
    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 "\u4e00\u4e01"]
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]







|










|






|







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
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
    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\u001abat"
    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]







|


|






|


|







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
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
    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()







|
















|







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
946
947
948
949
950
951
952
953
    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)








|







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
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
    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








|


|







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
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
    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\u4e00ok\n\u4e01more 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\u4e00ok" 11 "\u4e01more 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 {}







|






|







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 "thereok\nmore 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 "thereok" 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
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
} {{} 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 "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis -buffersize 16
    set x [gets $f]
    close $f
    set x
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
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 "1234567890123\uff10\uff11" 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 "1234567890123\uff10\uff11\uff12\uff13" 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"







|






|





|










|








|



|














|







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
1240
1241
1242
1243
1244
1245
1246
1247
    # 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 {
} {}







|







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
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
	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 "\u672c" 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
	}







|





|



|

|







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
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
    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 \u7266 {} 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 \uBEEF 20][string repeat . 20]]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}







|









|







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
1497
1498
1499
1500
1501
1502
1503
1504
        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 \uBEEF 10]....\uBEEF]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}







|







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
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
        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







|










|










|







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
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
    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 != '\0')

    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 != '\0')

    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







|












|







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
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
# 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]







|

|

|







|

|

|







|

|

|







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
2074
2075
2076
2077
2078
2079
2080
2081
    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]







|







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
2161
2162
2163
2164
2165
2166
2167
2168
} {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)







|







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
2233
2234
2235
2236
2237
2238
2239
2240
    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 knownMsvcBug} {
    # 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 {







|







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
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
    }
    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]] \







|

|







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
2837
2838
2839
2840
2841
2842
2843
2844
    # 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 knownMsvcBug} {
    # 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}







|







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
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
    }
    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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation auto
    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]







|















|




















|


|











|



|
















|



















|







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
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
    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.







|











|

















|














|













|













|













|













|













|







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
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
    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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    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 -eofchar \x1a
    fconfigure $f -translation auto
    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 -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f







|














|



|



















<
|

















|







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
3825
3826
3827
3828
3829
3830
3831
3832
    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







|







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
3847
3848
3849
3850
3851
3852
3853
3854
    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







|







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
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
    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







|








|

















|

















|

















|

















|

















|







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
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
    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} {







|


















|







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
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
    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)







|




|








|




|








|




|








|




|








|




|








|




|














|














|














|














|














|














|







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
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
    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)







|




|








|




|







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
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
    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







|














|







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
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
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 17.2 was removed.
#
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







<
<
<







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
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
    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
} \u7266
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
} \u7266
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







|






|




|






|










|

















|







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
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
    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 "%#o" [expr $stats(mode)&0o777]
} [format %#5o [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}]







|













|
|







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
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
    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\0ipt"
    lappend result [string length [fileevent $f readable]]
    fileevent $f r "new scr\0ipt"
    lappend result [string length [fileevent $f readable]]
    fileevent $f r "yet ano\0ther"
    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} {







|

|

|







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
6363
6364
6365
6366
6367
6368
6369
6370
	   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)







|







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
6391
6392
6393
6394
6395
6396
6397
6398
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    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)







|







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
6419
6420
6421
6422
6423
6424
6425
6426
	   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)







|







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
6447
6448
6449
6450
6451
6452
6453
6454
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    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)







|







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
6475
6476
6477
6478
6479
6480
6481
6482
	   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)







|







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
6503
6504
6505
6506
6507
6508
6509
6510
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    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)







|







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
6531
6532
6533
6534
6535
6536
6537
6538
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation lf
    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)







|







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
6559
6560
6561
6562
6563
6564
6565
6566
	   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)







|







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
6587
6588
6589
6590
6591
6592
6593
6594
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation cr
    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)







|







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
6615
6616
6617
6618
6619
6620
6621
6622
	   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)







|







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
6643
6644
6645
6646
6647
6648
6649
6650
	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation crlf
    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)







|







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
6671
6672
6673
6674
6675
6676
6677
6678
	   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} {







|







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
7157
7158
7159
7160
7161
7162
7163
7164
} {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







|







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
7218
7219
7220
7221
7222
7223
7224
7225
# 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 "\u0410\u0410"
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]








|







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
7270
7271
7272
7273
7274
7275
7276
7277
    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 "\u0410\u0410"
    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]







|







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
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
    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 {}}} {







|


















|







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
7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
	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
    }







|





|







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
8135
8136
8137
8138
8139
8140
8141
8142
    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 knownMsvcBug} {
    # 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"







|







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
8390
8391
8392
8393
8394
8395
8396
8397

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]







|







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
8748
8749
8750
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
8762
8763
    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\u00c2\u00a0data"
    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\u00a0data 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 {







|







|







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
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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

package require tcltests

# Custom constraints used in this file
testConstraint testchannel	[llength [info commands testchannel]]

#----------------------------------------------------------------------








|
|
|










|







1
2
3
4
5
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
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 \u0248		;# gets truncated to \u0048
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation binary
    set result [read -nonewline $f]
    close $f
    set result
} \u0048

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?"}}







|






|







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
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 (c) 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 Tcltest [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







|











|







1
2
3
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
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 (c) 2000 Ajuba Solutions.
# Copyright (c) 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 Tcltest [info patchlevel]]

namespace eval ::tcl::test::iogt {
    namespace import ::tcltest::*

testConstraint testchannel [llength [info commands testchannel]]

set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=








|
|








|







1
2
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

set minus -
testConstraint testevalex [llength [info commands testevalex]]

# Tests of Tcl_LindexObjCmd, NOT COMPILED

test lindex-1.1 {wrong # args} testevalex {






|
|
|
|










|







1
2
3
4
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
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 (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testlink [llength [info commands testlink]]
testConstraint testlinkarray [llength [info commands testlinkarray]]

foreach i {int real bool string} {
    unset -nocomplain $i
}






|
|
|










|







1
2
3
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 "" "\0" "\0\0"]
    set e "{} \0 \0\0"
    string equal $l $e
} 1
test list-1.28 {basic null treatment} {
    set result "\0a\0b"
    list $result [string length $result]
} "\0a\0b 4"
test list-1.29 {basic null treatment} {
    set result "\0a\0b"
    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 "\0abc" "xyz"]
    set e "\0abc 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







|
|



|

|

|





|
|







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
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]
	    }
	    set i [expr $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}








|

|

|





|





|
|

|







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
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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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







|
|










|







1
2
3
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 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]} {






|
|
|







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
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] "







|







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
7
8
9
10
11
12
13
14
15
16
17
18
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
# 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 (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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 'teststaticpkg' command from tcltest

testConstraint teststaticpkg [llength [info commands teststaticpkg]]

# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest

testConstraint testsimplefilesystem \
	[llength [info commands testsimplefilesystem]]

test load-1.1 {basic errors} {} {
    list [catch {load} msg] $msg
} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
test load-1.2 {basic errors} {} {
    list [catch {load a b c d} msg] $msg
} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
test load-1.3 {basic errors} {} {
    list [catch {load a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
test load-1.4 {basic errors} {} {
    list [catch {load -global {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.5 {basic errors} {} {
    list [catch {load -lazy {} {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.6 {basic errors} {} {
    list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}
test load-1.7 {basic errors} {} {
    list [catch {load -abc foo} msg] $msg
} "1 {bad option \"-abc\": must be -global, -lazy, or --}"
test load-1.8 {basic errors} {} {
    list [catch {load -global} msg] $msg
} "1 {couldn't figure out package name 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 package 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 package \"Pkga\""

test load-5.1 {file name not specified and no static package: pick default} \
	[list $dll $loaded] {
    catch {interp delete x}
    interp create x

    load -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    set result [info loaded x]

    interp delete x
    set 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_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg Test 1 0
    load {} Test
    load {} Test child
    list [set x] [child eval set x]
} {loaded loaded}
test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg 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 package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg 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 currentRealPackages [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_StaticPackage procedure, redundant calls} -setup {
    teststaticpkg Test 1 0
    teststaticpkg Another 0 0
    teststaticpkg More 0 1
} -constraints [list teststaticpkg $dll $loaded] -body {
    teststaticpkg Double 0 1
    teststaticpkg Double 0 1
    info loaded
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]

testConstraint teststaticpkg_8.x \
    [if {[testConstraint teststaticpkg]} {

	teststaticpkg Test 1 1
	teststaticpkg Another 0 1
	teststaticpkg More 0 1
	teststaticpkg Double 0 1
	expr 1
    } else {
	expr 0
    }]


test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {

    lsort -index 1 [info loaded]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticpkg_8.x} -body {
    info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg_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 {TclGetLoadedPackages procedure} [list teststaticpkg_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 {TclGetLoadedPackages procedure} [list teststaticpkg_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_StaticPackage, load already-loaded package into another interp} \
    -constraints {teststaticpkg} \
    -setup {
	interp create child1
	interp create child2
	load {} Tcltest child1
	load {} Tcltest child2
    } \
    -body {
	child1 eval { teststaticpkg Loadninepointone 0 1 }
	child2 eval { teststaticpkg Loadninepointone 0 1 }
	list \
	    [child1 eval { info loaded {} }] \
	    [child2 eval { info loaded {} }]
    } \


    -match glob -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} \
    -cleanup { interp delete child1 ; interp delete child2 }

test load-10.1 {load from vfs} \



    -constraints [list $dll $loaded testsimplefilesystem] \
    -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \
    -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}







|
|










|



















|

|






|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|









|





|





|



|







|






|









|


|


|

|
|

|
<


>
|
|
|
>

<
|










|

|




|

|




|
|

|



|
|
|
|
|
|
|
|
|
|
|

|

|
|
>
|
|
|
|
<
|
<
<
|
>
|
>

|
|


|


|


|
|




|
<
<
|
|
|
|
<
|
|
|
<
|
|
|
>
>
|
<

|
>
>
>
|
<
|
|
|
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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} {






|
|
|










|







1
2
3
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
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 (c) 2003 by 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::*






|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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\000two bar] bar
} 2
test lsearch-4.2 {binary data} {
    set x one
    append x \x00
    append x two
    lsearch -exact [list foo one\000two bar] $x
} 1

# Make a sorted list
set l {}
set l2 {}
for {set i 0} {$i < 100} {incr i} {
    lappend l $i







|





|







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
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







|







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
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 (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

proc failTrace {name1 name2 op} {
    error "trace failed"
}

testConstraint testevalex [llength [info commands testevalex]]









|










|







1
2
3
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
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 (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*








|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 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::*






|







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
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 (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
14
15
16
17
18
19
20
21
22
23
24
25
26
# 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 Tcltest package loaded?
    #	- that is, the special C-coded testing commands in tclTest.c
    #   - tests use testing commands introduced in Tcltest 8.4
    testConstraint Tcltest [expr {
	[llength [package provide Tcltest]]
	&& [package vsatisfies [package provide Tcltest] 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













|
<
<
|
|
|







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
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
    } -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 \u00c0]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
	removeFile script
    } -result [list script [list [encoding convertfrom [encoding system] \
	[encoding convertto [encoding system] \u00c0]]] 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 \u20ac]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
	removeFile script
    } -result [list script [list [encoding convertfrom [encoding system] \
	[encoding convertto [encoding system] \u20ac]]] 0]\n

    test Tcl_Main-1.5 {
    } -constraints {
	stdio
    } -setup {
	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0
	catch {set f [open "|[list [interpreter] \u00c0]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
	removeFile \u00c0
    } -result [list [list [encoding convertfrom [encoding system] \
	[encoding convertto [encoding system] \u00c0]]] {} 0]\n

    test Tcl_Main-1.6 {
    } -constraints {
	stdio
    } -setup {
	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac
	catch {set f [open "|[list [interpreter] \u20ac]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
	removeFile \u20ac
    } -result [list [list [encoding convertfrom [encoding system] \
	[encoding convertto [encoding system] \u20ac]]] {} 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 \u20ac }
	puts $f "\u20ac]"
	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 "\u20ac]"
	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 "\u20ac]"
	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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -body {
	exec [interpreter] << {puts "In script"} \
		-appinitprocclosestderr >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f







|






|






|






|





|
|




|

|





|
|




|

|











|
|




















|




















|

















|















|












|















|













|







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
339
340
341
342
343
344
345
346
	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 Tcltest
    } -setup {
	makeFile {
		rename exit _exit
		proc exit {code} {
		    puts "In exit"
		    _exit $code
		}







|







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
367
368
369
370
371
372
373
374
	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 Tcltest
    } -setup {
	makeFile {
		close stdin
		testsetmainloop
		rename exit _exit
		proc exit {code} {
		    puts "In exit"







|







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
396
397
398
399
400
401
402
403
	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 Tcltest
    } -setup {
	makeFile {
		rename exit _exit
		proc exit {code} {
		    puts "In exit"
		    _exit $code
		}







|







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
420
421
422
423
424
425
426
427
	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 Tcltest
    } -setup {
	makeFile {
		testsetmainloop
		rename exit _exit
		proc exit {code} {
		    puts "In exit"
		    _exit $code







|







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
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
    } -result {}

    # Tests Tcl_Main-4.*: rc file evaluation

    test Tcl_Main-4.1 {
	Tcl_Main: rcFile evaluation deletes interp
    } -constraints {
	exec Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -setup {
	set rc [makeFile {
		close stdin
		testsetmainloop
		after 0 testexitmainloop
		testexithandler create 0
		rename exit _exit







|
















|
















|







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
526
527
528
529
530
531
532
533
	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 Tcltest
    } -setup {
	set rc [makeFile {
		testsetmainloop
		after 0 testexitmainloop
		testexithandler create 0
		rename exit _exit
		proc exit code {







|







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
553
554
555
556
557
558
559
560
	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 Tcltest
    } -setup {
        set rc [makeFile {
                testsetmainloop
                after 0 {puts "Event callback"}
        } rc]
    } -body {
        set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+]







|







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
611
612
613
614
615
616
617
618
619
	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 \\032
	    if 1 \{\n\032"
	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







|
|







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
701
702
703
704
705
706
707
708
	file delete result
    } -result "bar\n"

    test Tcl_Main-5.8 {
	Tcl_Main: interactive mode: close stdin
		-> main loop & [exit] & exit handlers
    } -constraints {
	exec Tcltest
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}







|







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
725
726
727
728
729
730
731
732
	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 Tcltest
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}







|







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
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
	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 Tcltest
    } -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 Tcltest
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}







|




















|







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
791
792
793
794
795
796
797
798
	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 Tcltest
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}







|







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
844
845
846
847
848
849
850
851
	close $f
	file delete result
    } -result "1\n% "

    test Tcl_Main-6.2 {
	Tcl_Main: prompt deletes interp
    } -constraints {
	exec Tcltest
    } -body {
	exec [interpreter] << {
		set tcl_prompt1 {testinterpdelete {}}
		set tcl_interactive 1
		puts "not reached"
	} >& result
	set f [open result]







|







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
896
897
898
899
900
901
902
903
	close $f
	file delete result
    } -result "1\n% YES\n"

    test Tcl_Main-6.5 {
	Tcl_Main: interactive entry to main loop
    } -constraints {
	exec Tcltest
    } -body {
	exec [interpreter] << {
		set tcl_interactive 1
		testsetmainloop
		testexitmainloop} >& result
	set f [open result]
	read $f







|







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
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
    } -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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -body {
	exec [interpreter] << {
		testsetmainloop
		testexithandler create 0
		rename exit _exit
		proc exit code {
		    puts "In exit"







|















|



















|
















|







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
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
	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 Tcltest
    } -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 Tcltest
    } -body {
	exec [interpreter] << {
		testsetmainloop
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code







|




















|







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
1065
1066
1067
1068
1069
1070
1071
1072
	close $f
	file delete result
    } -result "1\nExit MainLoop\nIn exit\n"

    test Tcl_Main-8.5 {
	StdinProc: handles interactive stdin close
    } -constraints {
	exec Tcltest
    } -body {
	exec [interpreter] << {
		testsetmainloop
		set tcl_interactive 1
		rename exit _exit
		proc exit code {
		    puts "In exit"







|







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
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
	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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -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 Tcltest
    } -body {
	exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result







|


















|
















|

















|















|

















|















|


















|







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
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 (c) 2006 Donal K. Fellows
# Copyright (c) 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::*






|
|







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
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







|
|

|







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
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 (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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








|
|
|










|







1
2
3
4
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
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 (c) 1998 Mark Harrison.
# Copyright (c) 1998-1999 by 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.




|
|







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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1997 Lucent Technologies
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*









|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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?







|





|







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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by 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 Tcltest [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_*








|
|











|







1
2
3
4
5
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
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 (c) 2003 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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 {}










|










|







1
2
3
4
5
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
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 (c) 2008 by 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 Tcltest [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.
#






|










|







1
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
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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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







|
|










|







1
2
3
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
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\u7777]
    lappend result [catch {testbooleanobj not 1} msg]
    lappend result $msg
} "1\u7777 1 {expected boolean value but got \"1\u7777\"}"

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}







|


|







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
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 (c) 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 TclOO 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




|




|







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
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 TclOO
    }
    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 TclOO
	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







|






|







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
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 TclOO
	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 TclOO
	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 TclOO package} {
    list [lsearch -nocase -all -inline [package names] tcloo] \
	[package present TclOO] [expr {$::oo::patchlevel in [package versions TclOO]}]
} [list TclOO $::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







|










|


















|
|
|
|







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
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 TclOO
    }
} -body {
    subinterp eval {
	oo::define oo::object constructor {} {
	    lappend ::result [info level 0]
	}
	lappend result 1







|







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
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 TclOO
    }
} -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 TclOO
    }
} -body {
    subinterp eval {
	oo::define oo::object destructor {
	    lappend ::result died
	}
	lappend result 1 [oo::object create foo]







|



















|







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
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







|











|







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
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]







|













|







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
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 (c) 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 TclOO 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]} {




|




|







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
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 (c) 2014-2016 Andreas Kupries
# Copyright (c) 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 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





|
|




|







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
7
8
9
10
11
12
13
14
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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}






|
|
|




















|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 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 Tcltest [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::*







|
|
|










|







1
2
3
4
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
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








|







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
5
6
7
8
9
10
11
12
13
14
15
16
17
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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 Tcltest [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\0 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 {}}




|
|













|













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
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







|







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
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







|
|







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
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}







|



|













|


















|







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
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 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} {







|







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
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\0 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 {}}







|







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
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\0 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 {}}







|







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
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 \0]; puts hi"
} 1
test parse-15.56 {CommandComplete procedure} testbytestring {
    info complete "set x [testbytestring \0]; \{"
} 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







|


|







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
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]







|


|


|





|


|



|







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
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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\0 +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 {}}




|
|










|

















|

|









|

|

|





|

|









|

|

|














|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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 \u00a7 25]]
} -returnCodes error -result [format {invalid character "@"
in expression "...%s" @ 0"} [string repeat \u00a7 10]]
test parseExpr-21.38 {error messages} -body {
    expr [format {0 @ "%s"} [string repeat \u00a7 25]]
} -returnCodes error -result [format {invalid character "@"
in expression "0 @ "%s..."} [string repeat \u00a7 10]]
test parseExpr-21.39 {error messages} -body {
    expr [format {"%s" @ "%s"} [string repeat \u00a7 25] [string repeat \u00a7 25]]
} -returnCodes error -result [format {invalid character "@"
in expression "...%s" @ "%s..."} [string repeat \u00a7 10] [string repeat \u00a7 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 \u00a7 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 \u00a7 25]]"} [string repeat \u00a7 10] [string repeat \u00a7 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







|

|

|

|

|

|









|





|







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
1069
1070
1071
1072
1073
1074
1075
1076








1077
1078
1079
1080
} -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 \u0433 -1
} -returnCodes error -match glob -result {*invalid character*}
test parseExpr-22.20 {Bug d2ffcca163} -constraints testexprparser -body {
    testexprparser \u043f -1
} -returnCodes error -match glob -result {*invalid character*}
test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body {
    testexprparser in\u0433(0) -1
} -returnCodes error -match glob -result {missing operand*}









# cleanup
cleanupTests
return







|


|


|

>
>
>
>
>
>
>
>




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
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:  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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testwordend [llength [info commands testwordend]]
testConstraint testbytestring [llength [info commands testbytestring]]

# Save the argv value for restoration later
set savedArgv $argv

proc fourArgs {a b c d} {
    global arg1 arg2 arg3 arg4
    set arg1 $a








|
|
|










|


<







1
2
3
4
5
6
7
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
138
139
140
141
142
143
144
145
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







|







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
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
} "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} testbytestring {
    expr {[list \ua2] eq [testbytestring "\xc2\xa2"]}
} 1
test parseOld-7.13 {backslash substitution} testbytestring {
    expr {[list \u4e21] eq [testbytestring "\xe4\xb8\xa1"]}
} 1
test parseOld-7.14 {backslash substitution} testbytestring {
    expr {[list \u4e2k] eq [testbytestring "\xd3\xa2k"]}
} 1

# Semi-colon.

test parseOld-8.1 {semi-colons} {
    set b 0
    getArgs a;set b 2







|
|

|
|

|
|







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
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
    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-14.1 {TclWordEnd procedure} {testwordend} {
    testwordend " 	\n abc"
} {c}
test parseOld-14.2 {TclWordEnd procedure} {testwordend} {
    testwordend "   \\\n"
} {}
test parseOld-14.3 {TclWordEnd procedure} {testwordend} {
    testwordend "   \\\n "
} { }
test parseOld-14.4 {TclWordEnd procedure} {testwordend} {
    testwordend {"abc"}
} {"}
#" Emacs formatting :^(
test parseOld-14.5 {TclWordEnd procedure} {testwordend} {
    testwordend {{xyz}}
} \}
test parseOld-14.6 {TclWordEnd procedure} {testwordend} {
    testwordend {{a{}b{}\}} xyz}
} "\} xyz"
test parseOld-14.7 {TclWordEnd procedure} {testwordend} {
    testwordend {abc[this is a]def ghi}
} {f ghi}
test parseOld-14.8 {TclWordEnd procedure} {testwordend} {
    testwordend "puts\\\n\n  "
} "s\\\n\n  "
test parseOld-14.9 {TclWordEnd procedure} {testwordend} {
    testwordend "puts\\\n   	"
} "s\\\n   	"
test parseOld-14.10 {TclWordEnd procedure} {testwordend} {
    testwordend "puts\\\n   	xyz"
} "s\\\n   	xyz"
test parseOld-14.11 {TclWordEnd procedure} {testwordend} {
    testwordend {a$x.$y(a long index) foo}
} ") foo"
test parseOld-14.12 {TclWordEnd procedure} {testwordend} {
    testwordend {abc; def}
} {; def}
test parseOld-14.13 {TclWordEnd procedure} {testwordend} {
    testwordend {abc def}
} {c def}
test parseOld-14.14 {TclWordEnd procedure} {testwordend} {
    testwordend {abc	def}
} {c	def}
test parseOld-14.15 {TclWordEnd procedure} {testwordend} {
    testwordend "abc\ndef"
} "c\ndef"
test parseOld-14.16 {TclWordEnd procedure} {testwordend} {
    testwordend "abc"
} {c}
test parseOld-14.17 {TclWordEnd procedure} {testwordend} {
    testwordend "a\000bc"
} {c}
test parseOld-14.18 {TclWordEnd procedure} {testwordend} {
    testwordend \[a\000\]
} {]}
test parseOld-14.19 {TclWordEnd procedure} {testwordend} {
    testwordend \"a\000\"
} {"}
#" Emacs formatting :^(
test parseOld-14.20 {TclWordEnd procedure} {testwordend} {
    testwordend a{\000}b
} {b}
test parseOld-14.21 {TclWordEnd procedure} {testwordend} {
    testwordend "   \000b"
} {b}

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"







|




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}








|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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}}}}}








|












|







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
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}}}}}}








|


|







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
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







|


|







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
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 \







|
|















|







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
7
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 (c) 1999 by Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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 Tcltest [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)






|
















|







1
2
3
4
5
6
7
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
10
11
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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} {









|
|
|















|







1
2
3
4
5
6
7
8
9
10
11
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
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 {







|







|








|








|







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
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







|










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
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 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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


testConstraint procbodytest [expr {![catch {package require procbodytest}]}]
testConstraint memory	    [llength [info commands memory]]

catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename {} ""}
catch {unset msg}










|
|








>

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# 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
103
104
105
106
107
108
109
110
         [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} {







|







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
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
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 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 procbodytest -body {
    proc p x {return "$x:$x"}
    set rv [p P]
    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]
    procbodytest::proc t x p
    lappend rv [t T]
} -constraints procbodytest -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]
    procbodytest::proc t {x x1 x2} p
    lappend rv [t T]
} -constraints procbodytest -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]
    procbodytest::proc t {x x1 z} p
    lappend rv [t S T U]
} -constraints procbodytest -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]
    procbodytest::proc t {x y z} p
    lappend rv [t S T U]
} -constraints procbodytest -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]
    procbodytest::proc t {x y {z Z}} p
    lappend rv [t S T U]
} -returnCodes error -constraints procbodytest -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]
    procbodytest::proc t {x y {z ZZ}} p
    lappend rv [t S T U]
} -constraints procbodytest -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 {procbodytest memory} -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	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} procbodytest {
    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







|



|


|











|

|









|

|










|

|










|

|










|

|










|

|













|


|








|
|







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
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 (c) 2017 Frederic Bonnet
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# 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
7
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:  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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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-1.3 {pwd takes no args} -body {
    pwd foobar
} -returnCodes error -result "wrong \# args: should be \"pwd\""

# cleanup
::tcltest::cleanupTests
return






|
|
|













|

>
|






1
2
3
4
5
6
7
8
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
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 (c) 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 Tcltest [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










|







|







1
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
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[\u00fe-\u0507][\u00ff-\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}







|
|







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
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







|
|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 "\u4e4eb q"
    regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e 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"







|
|







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" "ab 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
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\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"
} {{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\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"] \
	[regexp -inline -indices -start 4 {(\w+)-(\w+)} \
	"gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"]
} {{{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







|




|

|







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
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\u4e4ebpqr"
    regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 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







|
|







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 "xyz555ijkabpqr"
    regsub ab xyzabijkabpqr 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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 "\u4e4eb q"
	regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar
	list [string compare $foo $bar] [regexp 4 $bar]
    }
} {0 0}

test regexpComp-1.8 {regexp ***= metasyntax} {
    evalInProc {
	regexp -- "***=o" "aeiou"







|
|







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" "ab 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
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\u4e4ebpqr"
	regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 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







|
|







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 "xyz555ijkabpqr"
	regsub ab xyzabijkabpqr 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
10
11
12
13
14
15
16
17
18
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 (c) 1997 by Sun Microsystems, Inc.  All rights reserved.
# Copyright (c) 1998-1999 by 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.5]
	}]} {
	testConstraint reg 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

# 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.5}
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} {









|
|










|




|









|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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 (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.

# Initialize message delimitor

# Initialize command array






|







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
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 < [expr $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 < [expr $argc - 1]} {
		set serverAddress [lindex $argv [expr $i + 1]]
	    }
	    break
	}
    }
}
if {![info exists serverAddress]} {
    set serverAddress 0.0.0.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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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}






|
|
|










|







1
2
3
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
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 (c) 2011 Gustaf Neumann <[email protected]>
# Copyright (c) 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 Tcltest [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 }






|
|










|







1
2
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
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 (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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]]






|
|










|







1
2
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
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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*







|
|







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



18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725

726
727
728
729
# 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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.5-




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}

# testing that nested and statics do what is advertised (we use a static
# package - Tcltest - but it might be absent if we're in standard tclsh)

testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]

# 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


# Local Variables:
# mode: tcl
# End:









|
|




<

>
>
>
|
|
|
|

|
|
|

|
|
|

|
|

|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
<
<
<
<
<
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|

|
|

|
|
|
|

|
|
|
|
|
|
|
|
|

|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|

|
|

|
|
|
|
|
|
|
|
|

|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|

|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|

|
|
|
|
|
|
|
|
|

|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|

|
|

|
|
|
|
|

|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>




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

16
17
18
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
17
18
19
20
21
22
23
24
25
26


27
28
29
30
31
32
33
#   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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

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]







|
|








>
>







10
11
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
57
58
59
60
61
62
63
64
65
66
}

# 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 - Tcltest - but it might be absent if we're in standard tclsh)

testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]

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







|

|







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
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
        {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 {teststaticpkg Safepkg1 0 0}
test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i {load {} Safepkg1}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i {load {} Safepkg1}} m o
    dict get $o -errorinfo
} -returnCodes ok -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
    invoked from within
"load {} Safepkg1"
    invoked from within
"interp eval $i {load {} Safepkg1}"}
test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body {
    set i [safe::interpCreate -nostatics]
    interp eval $i {load {} Safepkg1}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied (static package)}
test safe-10.3 {testing nested statics loading / no nested by default} -setup {
    set i [safe::interpCreate]
} -constraints TcltestPackage -body {
    interp eval $i {interp create x; load {} Safepkg1 x}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied (nested load)}
test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
    set i [safe::interpCreate -nestedloadok]
    interp eval $i {interp create x; load {} Safepkg1 x}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
    set i [safe::interpCreate -nestedloadok]
    catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
    dict get $o -errorinfo
} -returnCodes ok -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
    invoked from within
"load {} Safepkg1 x"
    invoked from within
"interp eval $i {interp create x; load {} Safepkg1 x}"}

test safe-11.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding
} -returnCodes error -cleanup {
    safe::interpDelete $i







|
|


|


|
|


|




|

|

|
|

|


|


|
|



|

|


|
|

|




|

|

|







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
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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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
	}







|

|









|

|

|





|

|









|

|

|







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
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\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
} -result "4 abc d\u00c7f ghijk dum"
test scan-7.7 {string and character scanning, unicode} -setup {
    set a {}; set b {}
} -body {
    list [scan "ab\u00c7cdef" "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 ...?"}







|
|



|




|
|







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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}









|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*








|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testset2 [llength [info commands testset2]]

catch {unset x}
catch {unset i}

test set-1.1 {TclCompileSetCmd: missing variable name} {






|
|










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
# 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
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 (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 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:
# ------------------------------------------
#






|
|







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
69
70
71


72
73
74
75
76
77
78
79
80


81
82
83
84
85
86
87

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
::tcltest::loadTestedCommands



if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} {
    return
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

# 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(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]



# 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 {







|


>
>
|


|




|
>
>







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
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

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] -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] -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







|













|

















|







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
1870
1871
1872
1873
1874
1875
1876
1877
      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 1 "== 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
    ]







|







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
1898
1899
1900
1901
1902
1903
1904
1905
        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 1 "** 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} {







|







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
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
      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 1 "** 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 1 "== 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 {







|








|







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
2393
2394
2395
2396
2397
2398
2399
2400
        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 knownMsvcBug} \
    -body {
        set sock [socket -async localhost [randport]]
        fconfigure $sock -blocking 0
        puts $sock ok
        fileevent $sock writable {set x 1}
        vwait x
        close $sock







|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by 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."






|
|
|







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
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}







|







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
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\0c"] 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\32c" 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) \u221A; 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 (\u001A) 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 \u001A 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) \u221A; set x correct"
    close $f
} -body {
    set x unset
    source -encoding utf-16 $sourcefile
    set x
} -cleanup {
    removeFile source.file







|








|













|










|

|





|







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
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 \u20ac {} {return foo}"
    close $f
} -body {
    source $sourcefile
    \u20ac

} -cleanup {
    removeFile source.file
    rename \u20ac {}
} -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 \u20ac {} {return foo}"
    close $f
} -body {
    source -encoding ascii $sourcefile
    \u20ac

} -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







|



<
>


|






|



<
>







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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\000c
        set y [split $x {}]
        return $y
    }
    foo
} "a b \000 c"
test split-1.10 {basic split commands} {
    split "a0ab1b2bbb3\000c4" ab\000c
} {{} 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 "\u0001ab\u0001cd\u0001\u0001ef\u0001" \1
} {{} 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\U1F4A9b" {}
} -result "a \U1F4A9 b"
test split-1.16 {basic split commands} -body {
    split "a\U1F4A9b" \U1F4A9
} -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







|




|

|





|








|
|

|







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
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 (c) 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::*






|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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}







|
|
|
|










|







1
2
3
4
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
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\u7266 ab\u7267}
} -1
test string-2.11.1.$noComp {string compare, unicode} {
    run {string compare \334 \xDC}
} 0
test string-2.11.2.$noComp {string compare, unicode} {
    run {string compare \334 \xFC}
} -1
test string-2.11.3.$noComp {string compare, unicode} {
    run {string compare \334\334\334\374\374 \334\334\334\334\334}
} 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







|


|


|


|







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
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 \334 \xDC}
} 0
test string-2.15.2.$noComp {string compare -nocase} {
    run {string compare -nocase \334\334\334\374\xFC \334\334\334\334\334}
} 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 \334\334\334 \334\334\374}
} -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







|


|
















|







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
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 \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334}
} 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







|







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
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\u7266 ab\u7267}
} 0
test string-3.17.$noComp {string equal, unicode} {
    run {string equal \334 \xDC}
} 1
test string-3.18.$noComp {string equal, unicode} {
    run {string equal \334 \xFC}
} 0
test string-3.19.$noComp {string equal, unicode} {
    run {string equal \334\334\334\374\374 \334\334\334\334\334}
} 0
test string-3.20.$noComp {string equal, high bit} {
    # This test will fail if the underlying comparaison
    # 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 \334 \xDC}
} 1
test string-3.23.$noComp {string equal, -nocase unicode} {
    run {string equal -nocase \334\334\334\374\xFC \334\334\334\334\334}
} 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 \334\334\334 \334\334\374}
} 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







|


|


|


|


|











|


|
















|







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
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\u7266x}
} 4
test string-4.10.$noComp {string first, unicode} {
    run {string first \u7266 abc\u7266x}
} 3
test string-4.11.$noComp {string first, start index} {
    run {string first \u7266 abc\u7266x 3}
} 3
test string-4.12.$noComp {string first, start index} -body {
    run {string first \u7266 abc\u7266x 4}
} -result -1
test string-4.13.$noComp {string first, start index} -body {
    run {string first \u7266 abc\u7266x 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 \u057E    ;# 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] \







|


|


|


|


|








|







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 abcx}
} 4
test string-4.10.$noComp {string first, unicode} {
    run {string first  abcx}
} 3
test string-4.11.$noComp {string first, start index} {
    run {string first  abcx 3}
} 3
test string-4.12.$noComp {string first, start index} -body {
    run {string first  abcx 4}
} -result -1
test string-4.13.$noComp {string first, start index} -body {
    run {string first  abcx 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
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\u7266d 4}
} d
test string-5.11.$noComp {string index, unicode} {
    run {string index abc\u7266d 3}
} \u7266
test string-5.12.$noComp {string index, unicode over char length, under byte length} -body {
    run {string index \334\374\334\374 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







|


|
|

|







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 abcd 4}
} d
test string-5.11.$noComp {string index, unicode} {
    run {string index abcd 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
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
    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 {}]


proc largest_int {} {
    # This will give us what the largest valid int on this machine is,
    # so we can test for overflow properly below on >32 bit systems
    set int 1
    set exp 7; # assume we get at least 8 bits
    while {wide($int) > 0} { set int [expr {wide(1) << [incr exp]}] }
    return [expr {$int-1}]
}

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} {







<
<
<
<
<
<
<
<
<







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
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
} 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\xFC}" 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\374}
} 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}







|







|







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
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
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\xDC567}] $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







|








|







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
637
638
639
640
641
642
643
644
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 [largest_int]0}] $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
    #







|







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
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
    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 +[largest_int]0}
} 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\xFCue}
} 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\xDCUE}] $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}







|

















|


|

















|








|







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
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
    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\xDCUE}
} 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\xFCue}] $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\xFCab\xDCAB\u5001\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}







|








|





|







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
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
    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 +[largest_int]0}] $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}







|

















|


|







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
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
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}







|




















|







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
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
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}

catch {rename largest_int {}}

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\u7266xx345x678}
} 12
test string-7.8.$noComp {string last, unicode} {
    run {string las \u7266 xxxx12\u7266xx345x678}
} 6
test string-7.9.$noComp {string last, stop index} {
    run {string las \u7266 xxxx12\u7266xx345x678}
} 6
test string-7.10.$noComp {string last, unicode} {
    run {string las \u7266 xxxx12\u7266xx345x678}
} 6
test string-7.11.$noComp {string last, start index} {
    run {string last \u7266 abc\u7266x 3}
} 3
test string-7.12.$noComp {string last, start index} {
    run {string last \u7266 abc\u7266x 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 \334a \334ad\334ad 0}
} -1
test string-7.16.$noComp {string last, start index} {
    run {string last \334a \334ad\334ad 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







<
<



















|


|


|


|


|


|










|


|







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 xxxx12xx345x678}
} 12
test string-7.8.$noComp {string last, unicode} {
    run {string las  xxxx12xx345x678}
} 6
test string-7.9.$noComp {string last, stop index} {
    run {string las  xxxx12xx345x678}
} 6
test string-7.10.$noComp {string last, unicode} {
    run {string las  xxxx12xx345x678}
} 6
test string-7.11.$noComp {string last, start index} {
    run {string last  abcx 3}
} 3
test string-7.12.$noComp {string last, start index} {
    run {string last  abcx 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
1053
1054
1055
1056
1057
1058
1059
1060
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\u7266"}
} 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







|







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
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
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 \374 ue UE \334] "a\374ueUE\000EU"}
} aueue\334\0EU
test string-10.13.$noComp {string map, -nocase unicode} {
    run {string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"}
} aue\334\334\0EU
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} {







|
|

|
|







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
1304
1305
1306
1307
1308
1309
1310
1311
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\334 A\374}
} 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]} _}







|







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
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
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\u7266cdefghijklmnop 5 5}
} e
test string-12.18.$noComp {string range, unicode} {
    run {string range ab\u7266cdefghijklmnop 2 3}
} \u7266c
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} {







|


|
|







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 abcdefghijklmnop 5 5}
} e
test string-12.18.$noComp {string range, unicode} {
    run {string range abcdefghijklmnop 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
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
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\u7266cd 3}
} ab\u7266cdab\u7266cdab\u7266cd
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\u7266cd 2 3}] 3}
} \u7266c\u7266c\u7266c

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?"}}







|
|





|
|







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 abcd 3}
} abcdabcdabcd
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 abcd 2 3}] 3}
} ccc

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
1860
1861
1862
1863
1864
1865
1866
1867
    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 \u0000}]]
} [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







|







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
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 (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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 {








|
|










|







1
2
3
4
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
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
    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\u00ef\u00bf\u00aeghi
    string length $x
    set y $x
    list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string"
test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} testobj {
    set x abc\u00ef\u00bf\u00aeghi
    set y $x
    string length $x
    list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi 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\u00ef\u00bf\u00aeghi
    testdstring free
    testdstring append \u00ae\u00bf\u00ef -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\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none"
test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj {
    set x abc\u00ef\u00bf\u00aeghi
    string length $x
    list [testobj objtype $x] [append x $x] [testobj objtype $x] \
	    [append x $x] [testobj objtype $x]
} "string abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi string\
abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi\
string"
test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {testobj testdstring} {
    set x abcdefghi
    testdstring free
    testdstring append \u00ae\u00bf\u00ef -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\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef 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\u00ef\u00bf\u00aeghi
    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\u00ef\u00bf\u00aeghijkl 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\u00ef\u00bf\u00aeghi
    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\u00ef\u00bf\u00aeghi9 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\u00fcb\u00e5c\u00ef
    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 \u00fc b \u00e5 c \u00ef"

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} {
    # Because this test does not use \uXXXX notation below instead of
    # hardcoding the values, it may fail in multibyte locales. However, we
    # need to test that the parser produces untyped objects even when there
    # are high-ASCII characters in the input (like "ï"). I don't know what
    # else to do but inline those characters here.
    testdstring free
    testdstring append "abc\u00ef\u00efdef" -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\u00EF\u00EFde" string string]
test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj {
    # set x "abcïïdef"
    # Use \uXXXX notation below instead of hardcoding the values, otherwise
    # the test will fail in multibyte locales.
    set x "abc\u00EF\u00EFdef"
    string length $x
    list [testobj objtype $x] [set y [string range $x 1 end-1]] \
	    [testobj objtype $x] [testobj objtype $y]
} [list string "bc\u00EF\u00EFde" string string]
test stringObj-10.4 {Tcl_GetRange with some 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 "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
    set result [list]
    while {[string length $a] > 0} {
	set a [string range $a 1 end-1]
	lappend result $a
    }
    set result
} [list a\u00BFb\u00AEc\u00EF\u00BFd	\
	\u00BFb\u00AEc\u00EF\u00BF	\
	b\u00AEc\u00EF			\
	\u00AEc				\
	{}]

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}







|


|

|

|


|

|
















|

|




|

|



|
|




|




|

















|






|




















|




|






|








|









<
<
<
<
<

|



|

|
<
<
<



|

|
<
<
<






|
|
|
|







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
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
    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 "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" 0
} "\u00ef"
test stringObj-12.5 {Tcl_GetUniChar} testobj {
    set x "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef"
    list [string index $x 4] [string index $x 0]
} "\u00ae \u00ef"
test stringObj-12.6 {Tcl_GetUniChar} testobj {
    string index "\u00efa\u00bfb\u00aec\u00ef\u00bfd\u00ae" end
} "\u00ae"

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 "\u00ae"
} 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 "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE"
} 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 "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
    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} {







|
|

|

|

|
|













|





|





|







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
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 (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 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 Tcltest [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 {






|
|
|









|







1
2
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
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 \344 \344"

test subst-4.1 {variable substitutions} {
    set a 44
    subst {$a}
} {44}
test subst-4.2 {variable substitutions} {
    set a 44







|







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
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}







|



|
|


|



|
|







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
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 (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 2008 by 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 Tcltest [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.
#






|










|







1
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
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 (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2000 by 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].




|
|







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
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 00333
	file attributes $notWriteableDir -permissions 00555
    }
    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}
    }
}







|
|







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
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







|







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
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 (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2006-2008 by 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 Tcltest [info patchlevel]]
package require tcltests

# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] ne {}}]








|
|
|













|







1
2
3
4
5
6
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
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 (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*









|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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\0cd"
    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\0cd
    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\0cd
    after cancel "set x ab\0ef"
    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\0cd
    after cancel set x ab\0ef
    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\0cd"
    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\0cd
    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\0cd]
    update
    string length [lindex [lindex [after info $id] 0] 2]
} -cleanup {
    foreach i [after info] {
	after cancel $i
    }
} -result 5







|










|










|
|












|
|












|









|










|







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
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 (c) 2004 by Donal K. Fellows.
# All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
# 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
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







|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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]]







|
|
|










|







1
2
3
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
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} {







|
|







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
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 (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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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]






|










|







1
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
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 0000
    file rename td1/td2/td3 td2
} -returnCodes error -cleanup {
    file attributes td1/td2 -permissions 0755
    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







|


|







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
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 040555
    file rename foo/bar /tmp
} -returnCodes error -cleanup {
    catch {file delete /tmp/bar}
    catch {file attr foo -perm 040777}
    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}







|



|







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
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 0000] \
	[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 0000
} -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 {







|







|







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
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 0000
    pwd
} -returnCodes error -cleanup {
    cd $cd
    file attributes $nd -permissions 0755
    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







|



|







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
7
8
9
10
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 (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testfindexecutable [llength [info commands testfindexecutable]]

set oldpwd [pwd]
cd [temporaryDirectory]

catch {
    set oldPath $env(PATH)
    file attributes [makeFile "" junk] -perm 0777
}
set absPath [file join [temporaryDirectory] junk]

test unixFile-1.1 {Tcl_FindExecutable} {testfindexecutable unix} {
    set env(PATH) ""
    testfindexecutable junk
} $absPath






|










|








|







1
2
3
4
5
6
7
8
9
10
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
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 (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*




|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
# 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
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 (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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] != '\0'))
    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







|







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
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) "\xa7"
    lindex [getlibpath] 0
} -cleanup {
    unset -nocomplain env(TCL_LIBRARY) env(LANG)
    if {[info exists oldlibrary]} {
	set env(TCL_LIBRARY) $oldlibrary
	unset oldlibrary
    }
} -result "\xa7"
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)







|







|







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
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 (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
7
8
9
10
11
12
13
14
15
16
17
18
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
# 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 (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2003-2004 by 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 Tcltest [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 require the 'teststaticpkg' command from tcltest
testConstraint teststaticpkg [llength [info commands teststaticpkg]]

# 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 ?packageName? ?interp?"}
test unload-1.2 {basic errors} -returnCodes error -body {
    unload a b c d
} -result {wrong # args: should be "unload ?-switch ...? fileName ?packageName? ?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 package name}
test unload-1.5 {basic errors} -returnCodes error -body {
    unload {} {}
} -result {must specify either file name or package name}
test unload-1.6 {basic errors} -returnCodes error -body {
    unload {} Unknown
} -result {package "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 package name} [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 package name} [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 package name} -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 package name} -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 package name} -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 package name} -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, with package name conversion} \
	[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, with package name conversion} \
	[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 package name} -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 package name} -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 package name} -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 package name 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 package name} -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, with package name conversion} -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, with package name conversion} -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 package name} -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 package name} -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 package name} -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






|
|
|










|




















<
<
<















|


|





|


|


|








|



|





|




|







|










|




















|


|



|


|









|

|




|

|







|











|







|













|











|








|





|



|





|


















|














|
















|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

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}}
}







|
|
|










|







1
2
3
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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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






|
|
|










|







1
2
3
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
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
# This file contains a collection of tests for tclUtf.c
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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 ucs2_utf16 [expr {![testConstraint ucs4]}]

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]]




|
|










|






<







1
2
3
4
5
6
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
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
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 {"\u4E4E" 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 Uesc testbytestring} {
    expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]}
} 1
test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {ucs2 Uesc 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 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc testbytestring} {



    expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]}
} 1




















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







|







|


|

















|
>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
107
108
109
110
111



112
113
114
115
116



117
118
119
120
121
122
123
} 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} {testbytestring ucs2_utf16} {
    string length [testbytestring \xF0\x90\x80\x80]
} 2
test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs4} {
    string length [testbytestring \xF0\x90\x80\x80]



} 1
test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} {
    string length [testbytestring \xF4\x8F\xBF\xBF]
} 2
test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc 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.







|


|
|
>
>
>

|


|
>
>
>







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
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
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 A[testbytestring \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 {Tcl_UtfNext} {testutfnext testbytestring} {



    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]







|



















|
>
>
>







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
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
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]
} -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_utf16} {
    testutfnext [testbytestring \xF2]
} 1
test utf-6.30.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF2]
} -1
test utf-6.31 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2]G
} 1
test utf-6.32.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
    testutfnext [testbytestring \xF2\xA0]
} 1
test utf-6.32.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF2\xA0]
} -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} {







|
|


















|


|
|
|



|


|
|
|







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
346
347
348
349
350
351
352
353
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 \u8820
} 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







|







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
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
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 \u8820G
} 3
test utf-6.63 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xA0]
} 3
test utf-6.64 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xD0]
} 3
test utf-6.65 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xE8]
} 3
test utf-6.66 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xF2]
} 3
test utf-6.67 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[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_utf16} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]
} 1
test utf-6.69.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    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_utf16} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G
} 1
test utf-6.74.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G
} 4
test utf-6.75.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0]
} 1
test utf-6.75.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0]
} 4
test utf-6.76.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0]
} 1
test utf-6.76.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0]
} 4
test utf-6.77.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8]
} 1
test utf-6.77.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8]
} 4
test utf-6.78.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2]
} 1
test utf-6.78.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2]
} 4
test utf-6.79.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8]
} 1
test utf-6.79.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    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]







|


|


|


|


|


|




|


|














|


|


|


|


|


|


|


|


|


|


|


|







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
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
} 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_utf16} {
    testutfnext [testbytestring \xF0\x90\x80\x80]
} 1
test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF0\x90\x80\x80]
} 4
test utf-6.88 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring} {
    testutfnext [testbytestring \xA0\xA0\x00]



} 2
test utf-6.89 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring} {
    testutfnext [testbytestring \x80\x80\x00]



} 2
test utf-6.90.0 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs2_utf16} {
    testutfnext [testbytestring \xF4\x8F\xBF\xBF]
} 1
test utf-6.90.1 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs4} {
    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 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring} {
    testutfnext [testbytestring \xA0\xA0\xA0]



} 3
test utf-6.93 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring} {
    testutfnext [testbytestring \x80\x80\x80]



} 3
test utf-6.94 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {
    testutfnext [testbytestring \xA0\xA0\xA0\xA0]



} 3
test utf-6.95 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {



    testutfnext [testbytestring \x80\x80\x80\x80]
} 3

test utf-7.1 {Tcl_UtfPrev} testutfprev {
    testutfprev {}
} 0
test utf-7.2 {Tcl_UtfPrev} testutfprev {







|


|


|

>
>
>

|

>
>
>

|


|





|

>
>
>

|

>
>
>

|

>
>
>

|
>
>
>







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
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
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\u8820[testbytestring \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 A[testbytestring \xA0]
} 1
test utf-7.8.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 2
} 1
test utf-7.8.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \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







|














|


|


|







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
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
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\u8820[testbytestring \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 A[testbytestring \xA0\xA0]
} 2
test utf-7.13.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 3
} 2
test utf-7.13.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \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







|

















|


|


|







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
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
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\u8820
} 1
test utf-7.16.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A\u8820[testbytestring \xA0] 4
} 1
test utf-7.16.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A\u8820[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 utf16} {
    testutfprev A[testbytestring \xA0\xA0\xA0]
} 1
test utf-7.18.1 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 4
} 1
test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xF8] 4
} 1
test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xF8\xA0\xA0\xA0]
} 2
test utf-7.20 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xF2\xA0\xA0\xA0]
} 2



test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A\u8820[testbytestring \xA0]
} 2
test utf-7.22 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xD0\xA0\xA0\xA0]
} 2
test utf-7.23 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0]
} 2
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} {







|


|


|










|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
|
|
|
|

|
|
|
|







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
709
710
711
712
713
714
715
716
717
718
} 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 utf16} {
    testutfprev A[testbytestring \xF0\x80\x80\x80]
} 2
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} {







|

|







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
739
740
741



742
743
744
745
746
747
748
} 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 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xF0\x90\x80\x80]
} 2



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} {







|

|
>
>
>







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
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781



782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
} 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 utf16} {
    testutfprev [testbytestring \xA0\xA0\xA0\xA0]
} 1
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 \u8820 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 utf16} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF]
} 2
test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {



    testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4
} 3
test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4
} 1
test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3
} 2
test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3
} 1
test utf-7.48.5 {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 utf16} {
    testutfprev A[testbytestring \xF4\x90\x80\x80]
} 2
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 \u4E4E\u25A 0
} \u4E4E
test utf-8.3 {Tcl_UniCharAtIndex: index > 0} {
    string index abcd 2
} c
test utf-8.4 {Tcl_UniCharAtIndex: index > 0} {
    string index \u4E4E\u25A\xFF\u543 2
} \xFF
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 \uD83D\uDE00G 0
} \U1F600
test utf-8.7.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \uD83D\uDE00G 0
} \U1F600
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 \uD83D\uDE00G 1
} G
test utf-8.8.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \uD83D\uDE00G 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 \uD83D\uDE00G 2
} {}
test utf-8.9.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \uD83D\uDE00G 2
} G
test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
    string index \U1F600G 0
} \uFFFD
test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
    string index \U1F600G 0
} \U1F600
test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
    string index \U1F600G 0
} \U1F600
test utf-8.11.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
    string index \U1F600G 1
} G
test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
    string index \U1F600G 1
} G
test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
    string index \U1F600G 1
} {}
test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
    string index \U1F600G 2
} {}
test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
    string index \U1F600G 2
} {}
test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
    string index \U1F600G 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 \u4E4E\u25A\xFF\u543klmnop 1 5
} \u25A\xFF\u543kl
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 \uD83D\uDE00G 0 0
} \U1F600
test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
    string range \uD83D\uDE00G 0 0
} \U1F600
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 \U1F600G 1 1
} G
test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
    string range \uD83D\uDE00G 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 \uD83D\uDE00G 2 2
} {}
test utf-9.5.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
    string range \uD83D\uDE00G 2 2
} G
test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs2} {
    string range \U1f600G 0 0
} \uFFFD
test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs4} {
    string range \U1f600G 0 0
} \U1F600
test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc utf16} {
    string range \U1f600G 0 0
} \U1F600
test utf-9.7.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} {
    string range \U1f600G 1 1
} G
test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} {
    string range \U1f600G 1 1
} G
test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} {
    string range \U1f600G 1 1
} {}
test utf-9.8.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} {
    string range \U1f600G 2 2
} {}
test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} {
    string range \U1f600G 2 2
} {}
test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} {
    string range \U1f600G 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} {Uesc fullutf testbytestring} {
    expr {"\U1E2165" eq "[testbytestring \xF0\x9E\x88\x96]5"}
} 1
test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {Uesc 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







|

|




|




|

|
|
>
>
>


|


|


|


|


|

|














|
|




|
|
















|
|

|
|




|


|





|


|

|
|

|
|
|
|
|
|
|
|

|
|

|
|

|
|

|
|

|
|






|
|




|
|

|
|




|


|





|


|

|
|

|
|
|
|
|
|
|
|

|
|

|
|

|
|

|
|

|
|


















|


|







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
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
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		{Uesc fullutf}
bsCheck \U01100000      69632		{Uesc fullutf}
bsCheck \U11000000      69632		{Uesc fullutf}
bsCheck \U0010FFFF      1114111		{Uesc fullutf}
bsCheck \U010FFFF0      1114111		{Uesc fullutf}
bsCheck \U10FFFF00      1114111		{Uesc fullutf}
bsCheck \UFFFFFFFF      1048575		{Uesc 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 \u01E3gh
} \u01E2GH
test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
    string toupper \u10D0\u1C90
} \u1C90\u1C90
test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} {Uesc fullutf} {
    string toupper \U10428
} \U10400
test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} fullutf {
    string toupper \uD801\uDC28
} \uD801\uDC00
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 \xC3GH
} \xE3gh
test utf-12.4 {Tcl_UtfToLower} {
    string tolower \u01E2GH
} \u01E3gh
test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
    string tolower \u10D0\u1C90
} \u10D0\u10D0
test utf-12.6 {Tcl_UtfToLower low/high surrogate)} {
    string tolower \uDC24\uD824
} \uDC24\uD824
test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} {Uesc fullutf} {
    string tolower \U10400
} \U10428
test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} fullutf {
    string tolower \uD801\uDC00
} \uD801\uDC28

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 \xE3GH
} \xC3gh
test utf-13.4 {Tcl_UtfToTitle} {
    string totitle \u01F3AB
} \u01F2ab
test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
    string totitle \u10D0\u1C90
} \u10D0\u1C90
test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
    string totitle \u1C90\u10D0
} \u1C90\u10D0
test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} {
    string totitle \uDC24\uD824
} \uDC24\uD824
test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} {Uesc fullutf} {
    string totitle \U10428\U10400
} \U10400\U10428
test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
    string totitle \uD801\uDC28\uD801\uDC00
} \uD801\uDC00\uD801\uDC28

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 \u0178\xFF
} \u0178\u0178
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 \u0178\xFF\uA78D\u01C5
} \xFF\xFF\u0265\u01C6

test utf-17.1 {Tcl_UniCharToLower, no delta} {
    string tolower !
} !

test utf-18.1 {Tcl_UniCharToTitle, add one for title} {
    string totitle \u01C4
} \u01C5
test utf-18.2 {Tcl_UniCharToTitle, subtract one for title} {
    string totitle \u01C6
} \u01C5
test utf-18.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} {
    string totitle \u017F
} \x53
test utf-18.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} {
    string totitle \xFF
} \u0178
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} knownBug {
    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 \u1040\u021F\u0220
} 1
test utf-21.2 {unicode alnum char in regc_locale.c} {
    # this returns 1 with Unicode 7 compliance
    list [regexp {^[[:alnum:]]+$} \u1040\u021F\u0220] [regexp {^\w+$} \u1040\u021F\u0220_\u203F\u2040\u2054\uFE33\uFE34\uFE4D\uFE4E\uFE4F\uFF3F]
} {1 1}
test utf-21.3 {unicode print char in regc_locale.c} {
    # this returns 1 with Unicode 7 compliance
    regexp {^[[:print:]]+$} \uFBC1
} 1
test utf-21.4 {TclUniCharIsGraph} {
    # [Bug 3464428]
    string is graph \u0120
} 1
test utf-21.5 {unicode graph char in regc_locale.c} {
    # [Bug 3464428]
    regexp {^[[:graph:]]+$} \u0120
} 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]







|
|
|
|
|
|
|











|
|

|
|
|
|
|

|
|











|
|

|
|

|
|



|
|
|

|
|








|
|

|
|

|
|

|
|



|
|
|

|
|


















|
|








|
|






|
|

|
|

|
|

|
|













|











|



|



|



|



|







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
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
    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\u5080z123_bar\u203C fg" 0
} 10

test utf-23.1 {TclUniCharIsAlpha} {
    # this returns 1 with Unicode 7 compliance
    string is alpha \u021F\u0220\u037F\u052F
} 1
test utf-23.2 {unicode alpha char in regc_locale.c} {
    # this returns 1 with Unicode 7 compliance
    regexp {^[[:alpha:]]+$} \u021F\u0220\u037F\u052F
} 1

test utf-24.1 {TclUniCharIsDigit} {
    # this returns 1 with Unicode 7 compliance
    string is digit \u1040\uABF0
} 1
test utf-24.2 {unicode digit char in regc_locale.c} {
    # this returns 1 with Unicode 7 compliance
    list [regexp {^[[:digit:]]+$} \u1040\uABF0] [regexp {^\d+$} \u1040\uABF0]
} {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} {







|




|



|




|



|







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 "xz123_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
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
}
variable count 1
UniCharCaseCmpTest < a b
UniCharCaseCmpTest > b a
UniCharCaseCmpTest > B a
UniCharCaseCmpTest > aBcB abca
UniCharCaseCmpTest < \uFFFF [format %c 0x10000] ucs4
UniCharCaseCmpTest < \uFFFF \U10000		{Uesc ucs4}
UniCharCaseCmpTest > [format %c 0x10000] \uFFFF	ucs4
UniCharCaseCmpTest > \U10000 \uFFFF		{Uesc ucs4}


test utf-26.1 {Tcl_UniCharDString} -setup {
    testobj freeallvars
} -constraints {teststringobj testbytestring} -cleanup {
    testobj freeallvars
} -body {







|

|







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
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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 (c) 1995-1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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
	}



|
|










|
















|

|









|

|

|

|

|





|

|









|

|

|

|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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







|







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
207
208
209
210
211
212
213
214



215
216
217
218
219
220
221
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
} {}




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







|
|
|





>
>
>







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
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
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 \u4e4fu
} 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\u4e4fc
} 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 "\[\u4e4fxy\]bc" "\u4e4fbc"
} 1
test util-5.14 {Tcl_StringMatch} {
    # if ((*pattern == ']') || (*pattern == '\0'))
    # badly formed pattern
    Wrapper_Tcl_StringMatch {[]} {[]}
} 0
test util-5.15 {Tcl_StringMatch} {
    # if ((*pattern == ']') || (*pattern == '\0'))
    # 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\u4e4fc]c" "a\u4e4fc"
} 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 \u4e4f
    Wrapper_Tcl_StringMatch {a[a\u4e4fc]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\u4e4fc]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 "\[\u4e00-\u4e4f]" "0"
} 0
test util-5.23 {Tcl_StringMatch: UTF-8 range} {
    Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\u4e33"
} 1
test util-5.24 {Tcl_StringMatch: UTF-8 range} {
    Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\uff08"
} 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







|






|












|


|




|









|



|
|




|








|


|


|







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 ac
} 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\[ac]c" "ac"
} 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[ac]c} [testbytestring a\x8Fc]
} 0
test util-5.19 {Tcl_StringMatch: UTF-8} {
    # pattern += Tcl_UtfToUniChar(pattern, &endChar);
    # proper advance.
    Wrapper_Tcl_StringMatch {a[ac]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
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
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} \ue1x
} 0
test util-5.43 {Tcl_StringMatch: skip correct number of ']'} {
    Wrapper_Tcl_StringMatch \[A-]\ue1]x \ue1x
} 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 == '\0')
    # 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} {







|


|





|







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
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
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\u0000 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 \u5420
    interp create [list \u5420 foo]
    interp alias {} fooset [list \u5420 foo] set
    set result [interp target {} fooset]
    interp delete \u5420
    set result
} "\u5420 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 \u5420 -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 \u00A0 -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







|




|


|










|
|
|

|

|






|






|







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
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
    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 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 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 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 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 free
    testdstring append {\\\\\\\\ } -1
    testdstring start
    testdstring end

    # Should make {\\\\\\\\ {}}
    list [llength [testdstring get]] [string index [testdstring get] 9]







|








|








|








|








|







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
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
    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







|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|







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
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
	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} {







|

|















|



|



|



|



|



|



|



|



|







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
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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 {} {










|
|










|







1
2
3
4
5
6
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
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 \u20ac \xe4] {info vars}
} -body {
    # test variable with non-ascii name is available (euro and a-uml chars here):
    list \
	[p 1 2] \
	[apply [list [list \u20ac \xe4] {info vars}] 1 2] \
	[apply [list [list [list \u20ac \u20ac] [list \xe4 \xe4]] {info vars}]] \
} -cleanup {
    rename p {}
} -result [lrepeat 3 [list \u20ac \xe4]]
test var-1.21 {TclLookupVar, regression on utf-8 variable names} -setup {
    proc p [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]}
} -body {
    # test variable with non-ascii name (and default) is resolvable (euro and a-uml chars here):
    list \
	[p] \
	[apply [list [list \u20ac \xe4] {list [set \u20ac] [set \xe4]}] v\u20ac v\xe4] \
	[apply [list [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]}]] \
} -cleanup {
    rename p {}
} -result [lrepeat 3 [list v\u20ac v\xe4]]

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 {







|




|
|


|

|




|
|


|







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
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 ""







|







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
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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








|
|
|











|







1
2
3
4
5
6
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
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







|

|











|







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
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 (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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}







|







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
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







|
|







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
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".








|







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
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







|
|
|







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
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







|
|
|















|







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
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}







|







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
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







|
|







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
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.








|







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
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







|
|
|















|







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
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







|
|
|







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
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 (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# 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
7
8
9
10
11
12
13
14
15
16
17
18
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 (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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.3]
	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
	testConstraint dde 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]


# -------------------------------------------------------------------------
# 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::*
	}






|














|
|



|













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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.3}

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]







|






|







|



|







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
7
8
9
10
11
12
13
14
15
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 (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Initialise the test constraints

testConstraint winVista 0
testConstraint winXP 0
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


testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $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
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
	}
	if {$x != ""} {
	    catch {file delete -force -- {*}$x}
	}
    }
}

if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) >= 5.0} {
	testConstraint winVista 1
    } else {
	testConstraint winXP 1
    }
}

# 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 *] {







<
<
<
<
<
<
<
<







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
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
# 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 notWine} -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 notWine} -body {
    testfile mv / td1
} -returnCodes error -result EINVAL
test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup {
    cleanup
} -constraints {win testfile notWine} -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 notWine} -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 {







|






|




|





|







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
207
208
209
210
211
212
213
214
215
216
217
218
} -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.13 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
} -constraints {win winXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL
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 {







<
<
<
<
<







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
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
    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.19 {TclpRenameFile: errno == EACCES} -setup {
    cleanup
} -constraints {win winXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL
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 notWine} -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:/







<
<
<
<
<



















|







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
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
} -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 notWine} -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 notWine} -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 notWine} -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 {







|






|






|







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
347
348
349
350
351
352
353
354
    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 notWine} -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 {







|







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
398
399
400
401
402
403
404
405
        lappend inodes $stat(ino)
        unset stat
    }
}

test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
    cleanup
} -constraints {win winNonZeroInodes knownMsvcBug notWine} -body {
    file mkdir td1
    foreach {a b} [MakeFiles td1] break
    file rename -force $a $b
    file exists $a
} -cleanup {
    cleanup
} -result {0}







|







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
448
449
450
451
452
453
454
455
456
457
458
459
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile cp tf1 ""
} -cleanup {
    cleanup
} -returnCodes error -result ENOENT
test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win winXP testfile} -body {
    testfile cp nul tf1
} -returnCodes error -result EINVAL
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 {







<
<
<
<
<







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
643
644
645
646
647
648
649
650
    list [file type td1] [file type td2]
} -cleanup {
    cleanup
} -result {directory directory}

test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    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
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
    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 {winVista testfile testchmod knownMsvcBug notWine} -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 notWine} -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 {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    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
944
945
946
947
948
949
950
951
} -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 {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1/td2
    testchmod 0 td1
    testfile rmdir -force td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    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
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
    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} -setup {
    catch {file delete -force -- c:/TclTmpC.1}
} -constraints {win winXP} -body {
    createfile c:/TclTmpC.1 {}
    string tolower [file attributes c:/TclTmpC.1 -longname]
} -cleanup {
    file delete -force -- c:/TclTmpC.1
} -result [string tolower {c:/TclTmpC.1}]
test winFCmd-12.6.2 {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







|
<
<
<
<
<
<
<
<







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
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
    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 notWine} -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 notWine} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -hidden 1] [file attributes td1 -hidden] \
	[file attributes td1 -hidden 0]
} -cleanup {
    cleanup







|







|







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
1174
1175
1176
1177
1178
1179
1180
1181
    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 notWine} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -system 1] [file attributes td1 -system]
} -cleanup {
    cleanup
} -result {{} 1}







|







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
7
8
9
10
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0

if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

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






|
|










|







|







1
2
3
4
5
6
7
8
9
10
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
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 (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [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






|
|










|







1
2
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
9
10
11
12
13
14
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 (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
unset -nocomplain path

catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}

set org_pwd [pwd]
set bindir [file join $org_pwd [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]

testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]


# several test-cases here expect current directory == [temporaryDirectory]:
cd [temporaryDirectory]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]








|
|












|
|






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 \032
    flush $f
    set r [read $f 64]
    catch {close $f}
    set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"

test winpipe-4.1 {Tcl_WaitPid} {win exec cat32} {







|







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
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 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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testwinclock [llength [info commands testwinclock]]


testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

# 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]






|
|










|


>
>
|







1
2
3
4
5
6
7
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
44
45
46
47
48
49
50
51
    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 knownMsvcBug} {
    # 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







|







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
7
8
9
10
11
12
13
14
15
16
17
18
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
# 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 (c) 1996-1998 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

# Removed in tip430 - zipfs is no longer a static package
#test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
#    load {} zipfs
#} -result {}

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 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 [::tcl::pkgconfig get zipfile,runtime]]
    testConstraint zipfslib [file isfile $tclzip]
    if {[testConstraint zipfslib]} {
        zipfs mount /lib/tcl $tclzip
        set ::tcl_library ${ziproot}lib/tcl/tcl_library
    }
}







|
|














<
<
<
<
<






|












|







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





23
24
25
26
27
28
29
30
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
278



































































































































279
280
281
282
283
284
} -body {
    interp eval $safe {
	zipfs mkzip
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand mkzip of zipfs}




































































































































::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






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
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 (c) 1996-1998 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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 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 {







|







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
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} {







|







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
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







|







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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
# This makefile is used to convert Tcl manual pages into various
# alternate formats:
#
#    Windows help file:  1. Build the winhelp target on Unix
#			 2. Build the helpfile target on Windows
#
#    HTML:		 1. Build the html target on Unix

TCL		= tcl@TCL_VERSION@
TK		= tk@TCL_VERSION@
VER		= @TCL_WIN_VERSION@

TCL_BIN_DIR	= @TCL_BIN_DIR@
TCL_SOURCE	= @TCL_SRC_DIR@
TK_SOURCE	= $(TCL_SOURCE)/../$(TK)
PRO_SOURCE	= $(TCL_SOURCE)/../pro
ITCL_SOURCE	= $(TCL_SOURCE)/../itcl3.1.0

TCL_DOCS	= $(TCL_SOURCE)/doc/*.[13n]

TK_DOCS		= $(TK_SOURCE)/doc/*.[13n]

PRO_DOCS	= \
	$(PRO_SOURCE)/doc/man/procheck.1 \
	$(PRO_SOURCE)/doc/man/prodebug.1 \
	$(PRO_SOURCE)/doc/man/prodebug.n \
	$(PRO_SOURCE)/doc/man/prolicense.1

ITCL_DOCS	= \
	$(ITCL_SOURCE)/itcl/doc/*.[13n] \
	$(ITCL_SOURCE)/itk/doc/*.[13n]

#	$(ITCL_SOURCE)/iwidgets3.0.0/doc/*.[13n]

COREDOCS	= $(TCL_DOCS) $(TK_DOCS)
#PRODOCS	= $(COREDOCS) $(PRO_DOCS) $(ITCL_DOCS)
PRODOCS		= $(COREDOCS) $(PRO_DOCS)
TCLSH		= $(TCL_BIN_DIR)/tclsh
CC		= @CC@

#
# Targets
#

all: core

pro:
	$(MAKE) DOCS="$(PRODOCS)" VER="" rtf

core:
	$(MAKE) DOCS="$(COREDOCS)" rtf

rtf: $(TCL_SOURCE)/tools/man2help.tcl man2tcl $(DOCS)
	LD_LIBRARY_PATH=$(TCL_BIN_DIR) \
	TCL_LIBRARY=$(TCL_SOURCE)/library \
	$(TCLSH) $(TCL_SOURCE)/tools/man2help.tcl tcl "$(VER)" $(DOCS)

winhelp: tcl.rtf

man2tcl: $(TCL_SOURCE)/tools/man2tcl.c
	$(CC) $(CFLAGS) -o man2tcl $(TCL_SOURCE)/tools/man2tcl.c

clean:
	-rm -f man2tcl *.o *.cnt *.rtf

helpfile:
	hcw /c /e tcl.hpj
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






































































































































Changes to tools/README.

1
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 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.
The tcl-tk-man-html.tcl script from Robert Critchlow
generates a nice set of HTML with good cross references.
Use it like
    tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl9.0
This script is very picky about the organization of man pages,
effectively acting as a style enforcer.

Generating Windows Help Files:
1) Build tcl in the ../unix directory
2) On UNIX, (after autoconf and configure), do
	make
    this converts the Nroff to RTF files.
2) On Windows, convert the RTF to a Help doc, do
	nmake helpfile












<
<
<
<


|
<
<
<
<
<
<
<
>
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
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 by 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."







|







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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##

# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac
fi


as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '
    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi
  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'
fi

# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; 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


# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

# 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
  test -z "$as_dir" && as_dir=.
    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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH

# Use a proper internal environment variable to ensure we don't fall
  # into an infinite loop, continuously re-executing ourselves.
  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
    _as_can_reexec=no; export _as_can_reexec;
    # We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
  *v*x* | *x*v* ) as_opts=-vx ;;
  *v* ) as_opts=-v ;;
  *x* ) as_opts=-x ;;
  * ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed `exec'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
as_fn_exit 255
  fi
  # We don't want this to propagate to other subprocesses.
          { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '\${1+\"\$@\"}'='\"\$@\"'
  setopt NO_GLOB_SUBST
else
  case \`(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
  exitcode=1; echo positional parameters were not saved.
fi
test x\$exitcode = x0 || 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"
  if (eval "$as_required") 2>/dev/null; then :
  as_have_required=yes
else
  as_have_required=no
fi
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :

else
  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
  test -z "$as_dir" && as_dir=.
  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_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
  CONFIG_SHELL=$as_shell as_have_required=yes
		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
  break 2
fi
fi
	   done;;
       esac
  as_found=false
done
$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
  CONFIG_SHELL=$SHELL as_have_required=yes
fi; }
IFS=$as_save_IFS


      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'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
fi

    if test x$as_have_required = xno; then :
  $as_echo "$0: This script requires a shell more modern than all"
  $as_echo "$0: the shells that I found on your system."
  if test x${ZSH_VERSION+set} = xset ; then
    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
  else
    $as_echo "$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
fi
SHELL=${CONFIG_SHELL-/bin/sh}
export SHELL
# Unset more variables known to interfere with behavior of common tools.
CLICOLOR_FORCE= GREP_OPTIONS=
unset CLICOLOR_FORCE GREP_OPTIONS

## --------------------- ##
## M4sh Shell Functions. ##
## --------------------- ##
# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset

# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit

# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(
      *\'*) as_qdir=`$as_echo "$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 ||
$as_echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
      test -d "$as_dir" && break
    done
    test -z "$as_dirs" || eval "mkdir $as_dirs"
  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"


} # as_fn_mkdir_p

# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
  test -f "$1" && test -x "$1"
} # as_fn_executable_p
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
  eval 'as_fn_append ()
  {
    eval $1+=\$2
  }'
else
  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_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith


# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
{
  as_status=$1; test $as_status -eq 0 && as_status=1
  if test "$4"; then
    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  as_fn_exit $as_status
} # as_fn_error

if expr a : '\(a\)' >/dev/null 2>&1 &&
   test "X`expr 00001 : '.*\(...\)'`" = X001; then
  as_expr=expr
else
  as_expr=false
fi

if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
  as_basename=basename
else
  as_basename=false
fi

if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
  as_dirname=dirname
else
  as_dirname=false
fi

as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`

# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits


  as_lineno_1=$LINENO as_lineno_1a=$LINENO
  as_lineno_2=$LINENO as_lineno_2a=$LINENO
  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)
  sed -n '
    p
    /[$]LINENO/=
  ' <$as_myself |
    sed '
      s/[$]LINENO.*/&-/
      t lineno
      b
      :lineno
      N
      :loop
      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
      t loop
      s/-\n.*//
    ' >$as_me.lineno &&
  chmod +x "$as_me.lineno" ||
    { $as_echo "$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
}

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
fi
if (echo >conf$$.file) 2>/dev/null; then
  if ln -s conf$$.file conf$$ 2>/dev/null; then
    as_ln_s='ln -s'
    # ... but there are two gotchas:
    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
    # In both cases, we have to default to `cp -pR'.
    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
      as_ln_s='cp -pR'
  elif ln conf$$.file conf$$ 2>/dev/null; then
    as_ln_s=ln
  else
    as_ln_s='cp -pR'
  fi
else
  as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null

if mkdir -p . 2>/dev/null; then
  as_mkdir_p='mkdir -p "$as_dir"'
else
  test -d ./-p && rmdir ./-p
  as_mkdir_p=false
fi

as_test_x='test -x'
as_executable_p=as_fn_executable_p

# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"

# Sed expression to map a string onto a valid variable name.
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"


test -n "$DJDIR" || exec 7<&0 </dev/null
exec 6>&1

# Name of the host.
# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`

#
# Initializations.
#
ac_default_prefix=/usr/local
ac_clean_files=
ac_config_libobj_dir=.
LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME=
PACKAGE_TARNAME=
PACKAGE_VERSION=
PACKAGE_STRING=
PACKAGE_BUGREPORT=
PACKAGE_URL=

ac_unique_file="man2tcl.c"
ac_subst_vars='LTLIBOBJS
LIBOBJS
TCL_BIN_DIR
TCL_SRC_DIR
TCL_PATCH_LEVEL
TCL_VERSION
CC
TCL_WIN_VERSION
target_alias
host_alias
build_alias
LIBS
ECHO_T
ECHO_N
ECHO_C
DEFS
mandir
localedir
libdir
psdir
pdfdir
dvidir
htmldir
infodir
docdir
oldincludedir
includedir
localstatedir
sharedstatedir
sysconfdir
datadir
datarootdir
libexecdir
sbindir
bindir
program_transform_name
prefix
exec_prefix
PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL'
ac_subst_files=''
ac_user_opts='
enable_option_checking
with_tcl
'
      ac_precious_vars='build_alias
host_alias
target_alias'


# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
ac_unrecognized_opts=
ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
exec_prefix=NONE
no_create=
no_recursion=
prefix=NONE
program_prefix=NONE
program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
srcdir=
verbose=
x_includes=NONE
x_libraries=NONE

# Installation directory options.
# These are left unexpanded so users can "make install exec_prefix=/foo"
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datarootdir='${prefix}/share'
datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE}'
infodir='${datarootdir}/info'
htmldir='${docdir}'
dvidir='${docdir}'
pdfdir='${docdir}'
psdir='${docdir}'
libdir='${exec_prefix}/lib'
localedir='${datarootdir}/locale'
mandir='${datarootdir}/man'

ac_prev=
ac_dashdash=
for ac_option
do
  # If the previous option needs an argument, assign it.
  if test -n "$ac_prev"; then
    eval $ac_prev=\$ac_option
    ac_prev=
    continue
  fi

  case $ac_option in
  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
  *=)   ac_optarg= ;;
  *)    ac_optarg=yes ;;
  esac

  # Accept the important Cygnus configure options, so we can diagnose typos.

  case $ac_dashdash$ac_option in
  --)
    ac_dashdash=yes ;;

  -bindir | --bindir | --bindi | --bind | --bin | --bi)
    ac_prev=bindir ;;
  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
    bindir=$ac_optarg ;;

  -build | --build | --buil | --bui | --bu)
    ac_prev=build_alias ;;
  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
    build_alias=$ac_optarg ;;

  -cache-file | --cache-file | --cache-fil | --cache-fi \
  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
    ac_prev=cache_file ;;
  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
    cache_file=$ac_optarg ;;

  --config-cache | -C)
    cache_file=config.cache ;;

  -datadir | --datadir | --datadi | --datad)
    ac_prev=datadir ;;
  -datadir=* | --datadir=* | --datadi=* | --datad=*)
    datadir=$ac_optarg ;;

  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
  | --dataroo | --dataro | --datar)
    ac_prev=datarootdir ;;
  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
    datarootdir=$ac_optarg ;;

  -disable-* | --disable-*)
    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid feature name: $ac_useropt"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
      *"
"enable_$ac_useropt"
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval enable_$ac_useropt=no ;;

  -docdir | --docdir | --docdi | --doc | --do)
    ac_prev=docdir ;;
  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
    docdir=$ac_optarg ;;

  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
    ac_prev=dvidir ;;
  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
    dvidir=$ac_optarg ;;

  -enable-* | --enable-*)
    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid feature name: $ac_useropt"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
      *"
"enable_$ac_useropt"
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval enable_$ac_useropt=\$ac_optarg ;;

  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
  | --exec | --exe | --ex)
    ac_prev=exec_prefix ;;
  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
  | --exec=* | --exe=* | --ex=*)
    exec_prefix=$ac_optarg ;;

  -gas | --gas | --ga | --g)
    # Obsolete; use --with-gas.
    with_gas=yes ;;

  -help | --help | --hel | --he | -h)
    ac_init_help=long ;;
  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
    ac_init_help=recursive ;;
  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
    ac_init_help=short ;;

  -host | --host | --hos | --ho)
    ac_prev=host_alias ;;
  -host=* | --host=* | --hos=* | --ho=*)
    host_alias=$ac_optarg ;;

  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
    ac_prev=htmldir ;;
  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
  | --ht=*)
    htmldir=$ac_optarg ;;

  -includedir | --includedir | --includedi | --included | --include \
  | --includ | --inclu | --incl | --inc)
    ac_prev=includedir ;;
  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
  | --includ=* | --inclu=* | --incl=* | --inc=*)
    includedir=$ac_optarg ;;

  -infodir | --infodir | --infodi | --infod | --info | --inf)
    ac_prev=infodir ;;
  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
    infodir=$ac_optarg ;;

  -libdir | --libdir | --libdi | --libd)
    ac_prev=libdir ;;
  -libdir=* | --libdir=* | --libdi=* | --libd=*)
    libdir=$ac_optarg ;;

  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
  | --libexe | --libex | --libe)
    ac_prev=libexecdir ;;
  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
  | --libexe=* | --libex=* | --libe=*)
    libexecdir=$ac_optarg ;;

  -localedir | --localedir | --localedi | --localed | --locale)
    ac_prev=localedir ;;
  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
    localedir=$ac_optarg ;;

  -localstatedir | --localstatedir | --localstatedi | --localstated \
  | --localstate | --localstat | --localsta | --localst | --locals)
    ac_prev=localstatedir ;;
  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
    localstatedir=$ac_optarg ;;

  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
    ac_prev=mandir ;;
  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
    mandir=$ac_optarg ;;

  -nfp | --nfp | --nf)
    # Obsolete; use --without-fp.
    with_fp=no ;;

  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
  | --no-cr | --no-c | -n)
    no_create=yes ;;

  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
    no_recursion=yes ;;

  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
  | --oldin | --oldi | --old | --ol | --o)
    ac_prev=oldincludedir ;;
  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
    oldincludedir=$ac_optarg ;;

  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
    ac_prev=prefix ;;
  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
    prefix=$ac_optarg ;;

  -program-prefix | --program-prefix | --program-prefi | --program-pref \
  | --program-pre | --program-pr | --program-p)
    ac_prev=program_prefix ;;
  -program-prefix=* | --program-prefix=* | --program-prefi=* \
  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
    program_prefix=$ac_optarg ;;

  -program-suffix | --program-suffix | --program-suffi | --program-suff \
  | --program-suf | --program-su | --program-s)
    ac_prev=program_suffix ;;
  -program-suffix=* | --program-suffix=* | --program-suffi=* \
  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
    program_suffix=$ac_optarg ;;

  -program-transform-name | --program-transform-name \
  | --program-transform-nam | --program-transform-na \
  | --program-transform-n | --program-transform- \
  | --program-transform | --program-transfor \
  | --program-transfo | --program-transf \
  | --program-trans | --program-tran \
  | --progr-tra | --program-tr | --program-t)
    ac_prev=program_transform_name ;;
  -program-transform-name=* | --program-transform-name=* \
  | --program-transform-nam=* | --program-transform-na=* \
  | --program-transform-n=* | --program-transform-=* \
  | --program-transform=* | --program-transfor=* \
  | --program-transfo=* | --program-transf=* \
  | --program-trans=* | --program-tran=* \
  | --progr-tra=* | --program-tr=* | --program-t=*)
    program_transform_name=$ac_optarg ;;

  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
    ac_prev=pdfdir ;;
  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
    pdfdir=$ac_optarg ;;

  -psdir | --psdir | --psdi | --psd | --ps)
    ac_prev=psdir ;;
  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
    psdir=$ac_optarg ;;

  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
  | -silent | --silent | --silen | --sile | --sil)
    silent=yes ;;

  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
    ac_prev=sbindir ;;
  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
  | --sbi=* | --sb=*)
    sbindir=$ac_optarg ;;

  -sharedstatedir | --sharedstatedir | --sharedstatedi \
  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
  | --sharedst | --shareds | --shared | --share | --shar \
  | --sha | --sh)
    ac_prev=sharedstatedir ;;
  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
  | --sha=* | --sh=*)
    sharedstatedir=$ac_optarg ;;

  -site | --site | --sit)
    ac_prev=site ;;
  -site=* | --site=* | --sit=*)
    site=$ac_optarg ;;

  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
    ac_prev=srcdir ;;
  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
    srcdir=$ac_optarg ;;

  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
  | --syscon | --sysco | --sysc | --sys | --sy)
    ac_prev=sysconfdir ;;
  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
    sysconfdir=$ac_optarg ;;

  -target | --target | --targe | --targ | --tar | --ta | --t)
    ac_prev=target_alias ;;
  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
    target_alias=$ac_optarg ;;

  -v | -verbose | --verbose | --verbos | --verbo | --verb)
    verbose=yes ;;

  -version | --version | --versio | --versi | --vers | -V)
    ac_init_version=: ;;

  -with-* | --with-*)
    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid package name: $ac_useropt"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$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=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
      *"
"with_$ac_useropt"
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval with_$ac_useropt=no ;;

  --x)
    # Obsolete; use --with-x.
    with_x=yes ;;

  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
  | --x-incl | --x-inc | --x-in | --x-i)
    ac_prev=x_includes ;;
  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
    x_includes=$ac_optarg ;;

  -x-libraries | --x-libraries | --x-librarie | --x-librari \
  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
    ac_prev=x_libraries ;;
  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
    x_libraries=$ac_optarg ;;

  -*) as_fn_error $? "unrecognized option: \`$ac_option'
Try \`$0 --help' for more information"
    ;;

  *=*)
    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
    # Reject names that are not valid shell variable names.
    case $ac_envvar in #(
      '' | [0-9]* | *[!_$as_cr_alnum]* )
      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
    esac
    eval $ac_envvar=\$ac_optarg
    export $ac_envvar ;;

  *)
    # FIXME: should be removed in autoconf 3.0.
    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
      $as_echo "$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" ;;
    *)     $as_echo "$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
do
  eval ac_val=\$$ac_var
  # Remove trailing slashes.
  case $ac_val in
    */ )
      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
      eval $ac_var=\$ac_val;;
  esac
  # Be sure to have absolute directory names.
  case $ac_val in
    [\\/$]* | ?:[\\/]* )  continue;;
    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
  esac
  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
done

# There might be people who depend on the old broken behavior: `$host'
# used to hold the argument of --host etc.
# FIXME: To remove some day.
build=$build_alias
host=$host_alias
target=$target_alias

# FIXME: To remove some day.
if test "x$host_alias" != x; then
  if test "x$build_alias" = x; then
    cross_compiling=maybe
  elif test "x$build_alias" != "x$host_alias"; then
    cross_compiling=yes
  fi
fi

ac_tool_prefix=
test -n "$host_alias" && ac_tool_prefix=$host_alias-

test "$silent" = yes && exec 6>/dev/null


ac_pwd=`pwd` && test -n "$ac_pwd" &&
ac_ls_di=`ls -di .` &&
ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
  as_fn_error $? "working directory cannot be determined"
test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
  as_fn_error $? "pwd does not report name of working directory"


# Find the source files, if location was not specified.
if test -z "$srcdir"; then
  ac_srcdir_defaulted=yes
  # Try the directory containing this script, then the parent directory.
  ac_confdir=`$as_dirname -- "$as_myself" ||
$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_myself" : 'X\(//\)[^/]' \| \
	 X"$as_myself" : 'X\(//\)$' \| \
	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_myself" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
  srcdir=$ac_confdir
  if test ! -r "$srcdir/$ac_unique_file"; then
    srcdir=..
  fi
else
  ac_srcdir_defaulted=no
fi
if test ! -r "$srcdir/$ac_unique_file"; then
  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
fi
ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
ac_abs_confdir=`(
	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
	pwd)`
# When building in place, set srcdir=.
if test "$ac_abs_confdir" = "$ac_pwd"; then
  srcdir=.
fi
# Remove unnecessary trailing slashes from srcdir.
# Double slashes in file names in object file debugging info
# mess up M-x gdb in Emacs.
case $srcdir in
*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
esac
for ac_var in $ac_precious_vars; do
  eval ac_env_${ac_var}_set=\${${ac_var}+set}
  eval ac_env_${ac_var}_value=\$${ac_var}
  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
  eval ac_cv_env_${ac_var}_value=\$${ac_var}
done

#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures this package to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.

Configuration:
  -h, --help              display this help and exit
      --help=short        display options specific to this package
      --help=recursive    display the short help of all the included packages
  -V, --version           display version information and exit
  -q, --quiet, --silent   do not print \`checking ...' messages
      --cache-file=FILE   cache test results in FILE [disabled]
  -C, --config-cache      alias for \`--cache-file=config.cache'
  -n, --no-create         do not create output files
      --srcdir=DIR        find the sources in DIR [configure dir or \`..']

Installation directories:
  --prefix=PREFIX         install architecture-independent files in PREFIX
                          [$ac_default_prefix]
  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
                          [PREFIX]

By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
an installation prefix other than \`$ac_default_prefix' using \`--prefix',
for instance \`--prefix=\$HOME'.

For better control, use the options below.

Fine tuning of the installation directories:
  --bindir=DIR            user executables [EPREFIX/bin]
  --sbindir=DIR           system admin executables [EPREFIX/sbin]
  --libexecdir=DIR        program executables [EPREFIX/libexec]
  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
  --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/PACKAGE]
  --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

  cat <<\_ACEOF

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
  --with-tcl=DIR          use Tcl $DEF_VER binaries from DIR

Report bugs to the package provider.
_ACEOF
ac_status=$?
fi

if test "$ac_init_help" = "recursive"; then
  # If there are subdirs, report their specific --help.
  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
    test -d "$ac_dir" ||
      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
      continue
    ac_builddir=.

case "$ac_dir" in
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
  case $ac_top_builddir_sub in
  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
  esac ;;
esac
ac_abs_top_builddir=$ac_pwd
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix

case $srcdir in
  .)  # We are building in place.
    ac_srcdir=.
    ac_top_srcdir=$ac_top_builddir_sub
    ac_abs_top_srcdir=$ac_pwd ;;
  [\\/]* | ?:[\\/]* )  # Absolute name.
    ac_srcdir=$srcdir$ac_dir_suffix;
    ac_top_srcdir=$srcdir
    ac_abs_top_srcdir=$srcdir ;;
  *) # Relative name.
    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_build_prefix$srcdir
    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix

    cd "$ac_dir" || { ac_status=$?; continue; }
    # Check for guested configure.
    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
      $as_echo "$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
configure
generated by GNU Autoconf 2.69

Copyright (C) 2012 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. ##
## ------------------------ ##
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 $as_me, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
## Platform. ##
## --------- ##

hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
uname -m = `(uname -m) 2>/dev/null || echo unknown`
uname -r = `(uname -r) 2>/dev/null || echo unknown`
uname -s = `(uname -s) 2>/dev/null || echo unknown`
uname -v = `(uname -v) 2>/dev/null || echo unknown`

/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`

/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`

_ASUNAME

as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    $as_echo "PATH: $as_dir"
  done
IFS=$as_save_IFS

} >&5

cat >&5 <<_ACEOF


## ----------- ##
## Core tests. ##
## ----------- ##

_ACEOF


# Keep a trace of the command line.
# Strip out --no-create and --no-recursion so they do not pile up.
# Strip out --silent because we don't want to record it for future runs.
# Also quote any args containing shell meta-characters.
# Make two passes to allow for proper duplicate-argument suppression.
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
ac_must_keep_next=false
for ac_pass in 1 2
do
  for ac_arg
  do
    case $ac_arg in
    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
    | -silent | --silent | --silen | --sile | --sil)
      continue ;;
    *\'*)
      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
    esac
    case $ac_pass in
    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
    2)
      as_fn_append ac_configure_args1 " '$ac_arg'"
      if test $ac_must_keep_next = true; then
	ac_must_keep_next=false # Got value, back to normal.
      else
	case $ac_arg in
	  *=* | --config-cache | -C | -disable-* | --disable-* \
	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
	  | -with-* | --with-* | -without-* | --without-* | --x)
	    case "$ac_configure_args0 " in
	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
	    esac
	    ;;
	  -* ) ac_must_keep_next=true ;;
	esac
      fi
      as_fn_append ac_configure_args " '$ac_arg'"
      ;;
    esac
  done
done
{ ac_configure_args0=; unset ac_configure_args0;}
{ ac_configure_args1=; unset ac_configure_args1;}

# When interrupted or exit'd, cleanup temporary files, and complete
# config.log.  We remove comments because anyway the quotes in there
# would cause problems or look ugly.
# WARNING: Use '\'' to represent an apostrophe within the trap.
# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
trap 'exit_status=$?
  # Save into config.log some information that might help in debugging.
  {
    echo

    $as_echo "## ---------------- ##
## 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_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
      esac
      case $ac_var in #(
      _ | IFS | as_nl) ;; #(
      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
      *) { eval $ac_var=; unset $ac_var;} ;;
      esac ;;
    esac
  done
  (set) 2>&1 |
    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
    *${as_nl}ac_space=\ *)
      sed -n \
	"s/'\''/'\''\\\\'\'''\''/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
      ;; #(
    *)
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
      ;;
    esac |
    sort
)
    echo

    $as_echo "## ----------------- ##
## Output variables. ##
## ----------------- ##"
    echo
    for ac_var in $ac_subst_vars
    do
      eval ac_val=\$$ac_var
      case $ac_val in
      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      esac
      $as_echo "$ac_var='\''$ac_val'\''"
    done | sort
    echo

    if test -n "$ac_subst_files"; then
      $as_echo "## ------------------- ##
## File substitutions. ##
## ------------------- ##"
      echo
      for ac_var in $ac_subst_files
      do
	eval ac_val=\$$ac_var
	case $ac_val in
	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	esac
	$as_echo "$ac_var='\''$ac_val'\''"
      done | sort
      echo
    fi

    if test -s confdefs.h; then
      $as_echo "## ----------- ##
## confdefs.h. ##
## ----------- ##"
      echo
      cat confdefs.h
      echo
    fi
    test "$ac_signal" != 0 &&
      $as_echo "$as_me: caught signal $ac_signal"
    $as_echo "$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

$as_echo "/* confdefs.h */" > confdefs.h

# Predefined preprocessor variables.

cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_URL "$PACKAGE_URL"
_ACEOF


# Let the site file select an alternate cache file if it wants to.
# Prefer an explicitly selected file to automatically selected ones.
ac_site_file1=NONE
ac_site_file2=NONE
if test -n "$CONFIG_SITE"; then
  # We do not want a PATH search for config.site.
  case $CONFIG_SITE in #((
    -*)  ac_site_file1=./$CONFIG_SITE;;
    */*) ac_site_file1=$CONFIG_SITE;;
    *)   ac_site_file1=./$CONFIG_SITE;;
  esac
elif test "x$prefix" != xNONE; then
  ac_site_file1=$prefix/share/config.site
  ac_site_file2=$prefix/etc/config.site
else
  ac_site_file1=$ac_default_prefix/share/config.site
  ac_site_file2=$ac_default_prefix/etc/config.site
fi
for ac_site_file in "$ac_site_file1" "$ac_site_file2"
do
  test "x$ac_site_file" = xNONE && continue
  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
$as_echo "$as_me: loading site script $ac_site_file" >&6;}
    sed 's/^/| /' "$ac_site_file" >&5
    . "$ac_site_file" \
      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
$as_echo "$as_me: loading cache $cache_file" >&6;}
    case $cache_file in
      [\\/]* | ?:[\\/]* ) . "$cache_file";;
      *)                      . "./$cache_file";;
    esac
  fi
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
$as_echo "$as_me: creating cache $cache_file" >&6;}
  >$cache_file
fi

# 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,)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
      ac_cache_corrupted=: ;;
    ,set)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
$as_echo "$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
	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
	  ac_cache_corrupted=:
	else
	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
	  eval $ac_var=\$ac_old_val
	fi
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
$as_echo "$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=`$as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
  as_fn_error $? "run \`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




# Recover information that Tcl computed with its configure script.

#--------------------------------------------------------------------
#       See if there was a command-line option for where Tcl is;  if
#       not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------

DEF_VER=9.0


# Check whether --with-tcl was given.
if test "${with_tcl+set}" = set; then :
  withval=$with_tcl; TCL_BIN_DIR=$withval
else
  TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`
fi

if test ! -d $TCL_BIN_DIR; then
    as_fn_error $? "Tcl directory $TCL_BIN_DIR doesn't exist" "$LINENO" 5
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
    as_fn_error $? "There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" "$LINENO" 5
fi

. $TCL_BIN_DIR/tclConfig.sh

TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

CC=$TCL_CC






ac_config_files="$ac_config_files Makefile tcl.hpj"

cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs, see configure's option --config-cache.
# It is not useful on other systems.  If it contains results you don't
# want to keep, you may remove or edit it.
#
# config.status only pays attention to the cache file if you give it
# the --recheck option to rerun configure.
#
# `ac_cv_env_foo' variables (set or unset) will be overridden when
# loading this file, other *unset* `ac_cv_foo' will be assigned the
# following values.

_ACEOF

# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
# So, we kill variables containing newlines.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(
  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
    eval ac_val=\$$ac_var
    case $ac_val in #(
    *${as_nl}*)
      case $ac_var in #(
      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
      esac
      case $ac_var in #(
      _ | IFS | as_nl) ;; #(
      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
      *) { eval $ac_var=; unset $ac_var;} ;;
      esac ;;
    esac
  done

  (set) 2>&1 |
    case $as_nl`(ac_space=' '; set) 2>&1` in #(
    *${as_nl}ac_space=\ *)
      # `set' does not quote correctly, so add quotes: double-quote
      # substitution turns \\\\ into \\, and sed turns \\ into \.
      sed -n \
	"s/'/'\\\\''/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
      ;; #(
    *)
      # `set' quotes correctly as required by POSIX, so do not add quotes.
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
      ;;
    esac |
    sort
) |
  sed '
     /^ac_cv_env_/b end
     t clear
     :clear
     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
     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
      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
$as_echo "$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
    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
  fi
fi
rm -f confcache

test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'

# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
# take arguments), then branch to the quote section.  Otherwise,
# look for a macro that doesn't take arguments.
ac_script='
:mline
/\\$/{
 N
 s,\\\n,,
 b mline
}
t clear
:clear
s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 (][^	 (]*([^)]*)\)[	 ]*\(.*\)/-D\1=\2/g
t quote
s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 ][^	 ]*\)[	 ]*\(.*\)/-D\1=\2/g
t quote
b any
:quote
s/[	 `~#$^&*(){}\\|;'\''"<>?]/\\&/g
s/\[/\\&/g
s/\]/\\&/g
s/\$/$$/g
H
:any
${
	g
	s/^\n//
	s/\n/ /g
	p
}
'
DEFS=`sed -n "$ac_script" confdefs.h`


ac_libobjs=
ac_ltlibobjs=
U=
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
  # 1. Remove the extension, and $U if already installed.
  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
  ac_i=`$as_echo "$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"
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
as_write_fail=0
cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
# Compiler output produced by configure, useful for debugging
# configure, is in config.log if it exists.

debug=false
ac_cs_recheck=false
ac_cs_silent=false

SHELL=\${CONFIG_SHELL-$SHELL}
export SHELL
_ASEOF
cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##

# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac
fi


as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '
    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi
  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'
fi

# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; 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


# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

# 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
  test -z "$as_dir" && as_dir=.
    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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH


# 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
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  as_fn_exit $as_status
} # as_fn_error


# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit

# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
  eval 'as_fn_append ()
  {
    eval $1+=\$2
  }'
else
  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_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith


if expr a : '\(a\)' >/dev/null 2>&1 &&
   test "X`expr 00001 : '.*\(...\)'`" = X001; then
  as_expr=expr
else
  as_expr=false
fi

if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
  as_basename=basename
else
  as_basename=false
fi

if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
  as_dirname=dirname
else
  as_dirname=false
fi

as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`

# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits

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
fi
if (echo >conf$$.file) 2>/dev/null; then
  if ln -s conf$$.file conf$$ 2>/dev/null; then
    as_ln_s='ln -s'
    # ... but there are two gotchas:
    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
    # In both cases, we have to default to `cp -pR'.
    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
      as_ln_s='cp -pR'
  elif ln conf$$.file conf$$ 2>/dev/null; then
    as_ln_s=ln
  else
    as_ln_s='cp -pR'
  fi
else
  as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null


# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(
      *\'*) as_qdir=`$as_echo "$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 ||
$as_echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
      test -d "$as_dir" && break
    done
    test -z "$as_dirs" || eval "mkdir $as_dirs"
  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"


} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
  as_mkdir_p='mkdir -p "$as_dir"'
else
  test -d ./-p && rmdir ./-p
  as_mkdir_p=false
fi


# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
  test -f "$1" && test -x "$1"
} # as_fn_executable_p
as_test_x='test -x'
as_executable_p=as_fn_executable_p

# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"

# Sed expression to map a string onto a valid variable name.
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"


exec 6>&1
## ----------------------------------- ##
## Main body of $CONFIG_STATUS script. ##
## ----------------------------------- ##
_ASEOF
test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by $as_me, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@

on `(hostname || uname -n) 2>/dev/null | sed 1q`
"

_ACEOF

case $ac_config_files in *"
"*) set x $ac_config_files; shift; ac_config_files=$*;;
esac



cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
# Files that config.status was made for.
config_files="$ac_config_files"

_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
\`$as_me' instantiates files and other configuration actions
from templates according to the current configuration.  Unless the files
and actions are specified as TAGs, all are instantiated by default.

Usage: $0 [OPTION]... [TAG]...

  -h, --help       print this help, then exit
  -V, --version    print version number and configuration settings, then exit
      --config     print configuration, then exit
  -q, --quiet, --silent
                   do not print progress messages
  -d, --debug      don't remove temporary files
      --recheck    update $as_me by reconfiguring in the same conditions
      --file=FILE[:TEMPLATE]
                   instantiate the configuration file FILE

Configuration files:
$config_files

Report bugs to the package provider."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
config.status
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

ac_pwd='$ac_pwd'
srcdir='$srcdir'
test -n "\$AWK" || AWK=awk
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# The default lists apply if the user does not specify any file.
ac_need_defaults=:
while test $# != 0
do
  case $1 in
  --*=?*)
    ac_option=`expr "X$1" : 'X\([^=]*\)='`
    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
    ac_shift=:
    ;;
  --*=)
    ac_option=`expr "X$1" : 'X\([^=]*\)='`
    ac_optarg=
    ac_shift=:
    ;;
  *)
    ac_option=$1
    ac_optarg=$2
    ac_shift=shift
    ;;
  esac

  case $ac_option in
  # Handling of the options.
  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
    ac_cs_recheck=: ;;
  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
    $as_echo "$ac_cs_version"; exit ;;
  --config | --confi | --conf | --con | --co | --c )
    $as_echo "$ac_cs_config"; exit ;;
  --debug | --debu | --deb | --de | --d | -d )
    debug=: ;;
  --file | --fil | --fi | --f )
    $ac_shift
    case $ac_optarg in
    *\'*) ac_optarg=`$as_echo "$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 )
    $as_echo "$ac_cs_usage"; exit ;;
  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
  | -silent | --silent | --silen | --sile | --sil | --si | --s)
    ac_cs_silent=: ;;

  # This is an error.
  -*) as_fn_error $? "unrecognized option: \`$1'
Try \`$0 --help' for more information." ;;

  *) as_fn_append ac_config_targets " $1"
     ac_need_defaults=false ;;

  esac
  shift
done

ac_configure_extra_args=

if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
  shift
  \$as_echo "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
  $as_echo "$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" ;;
    "tcl.hpj") CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;

  *) 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+set}" = set || CONFIG_FILES=$config_files
fi

# Have a temporary directory for convenience.  Make it in the build tree
# simply because there is no reason against having it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
# Hook for its removal unless debugging.
# Note that there is a small window in which the directory will not be cleaned:
# after its creation but before its name has been assigned to `$tmp'.
$debug ||
{
  tmp= ac_tmp=
  trap 'exit_status=$?
  : "${ac_tmp:=$tmp}"
  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
' 0
  trap 'as_fn_exit 1' 1 2 13 15
}
# Create a (secure) tmp directory for tmp files.

{
  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
  test -d "$tmp"
}  ||
{
  tmp=./conf$$-$RANDOM
  (umask 077 && mkdir "$tmp")
} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
ac_tmp=$tmp

# Set up the scripts for CONFIG_FILES section.
# No need to generate them if there are no CONFIG_FILES.
# This happens for instance with `./config.status config.h'.
if test -n "$CONFIG_FILES"; then


ac_cr=`echo X | tr X '\015'`
# On cygwin, bash can eat \r inside `` if the user requested igncr.
# But we know of no other shell where ac_cr would be empty at this
# point, so we can use a bashism as a fallback.
if test "x$ac_cr" = x; then
  eval ac_cr=\$\'\\r\'
fi
ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
  ac_cs_awk_cr='\\r'
else
  ac_cs_awk_cr=$ac_cr
fi

echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
_ACEOF


{
  echo "cat >conf$$subs.awk <<_ACEOF" &&
  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
  echo "_ACEOF"
} >conf$$subs.sh ||
  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
ac_delim='%!_!# '
for ac_last_try in false false false false false :; do
  . ./conf$$subs.sh ||
    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5

  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
  if test $ac_delim_n = $ac_delim_num; then
    break
  elif $ac_last_try; then
    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
  else
    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
  fi
done
rm -f conf$$subs.sh

cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
_ACEOF
sed -n '
h
s/^/S["/; s/!.*/"]=/
p
g
s/^[^!]*!//
:repl
t repl
s/'"$ac_delim"'$//
t delim
:nl
h
s/\(.\{148\}\)..*/\1/
t more1
s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
p
n
b repl
:more1
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
p
g
s/.\{148\}//
t nl
:delim
h
s/\(.\{148\}\)..*/\1/
t more2
s/["\\]/\\&/g; s/^/"/; s/$/"/
p
b
:more2
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
p
g
s/.\{148\}//
t delim
' <conf$$subs.awk | sed '
/^[^""]/{
  N
  s/\n//
}
' >>$CONFIG_STATUS || ac_write_fail=1
rm -f conf$$subs.awk
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
_ACAWK
cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
  for (key in S) S_is_set[key] = 1
  FS = ""

}
{
  line = $ 0
  nfields = split(line, field, "@")
  substed = 0
  len = length(field[1])
  for (i = 2; i < nfields; i++) {
    key = field[i]
    keylen = length(key)
    if (S_is_set[key]) {
      value = S[key]
      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
      len += length(value) + length(field[++i])
      substed = 1
    } else
      len += 1 + keylen
  }

  print line
}

_ACAWK
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
else
  cat
fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
_ACEOF

# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
# trailing colons and then remove the whole line if VPATH becomes empty
# (actually we leave an empty line to preserve line numbers).
if test "x$srcdir" = x.; then
  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{
h
s///
s/^/:/
s/[	 ]*$/:/
s/:\$(srcdir):/:/g
s/:\${srcdir}:/:/g
s/:@srcdir@:/:/g
s/^:*//
s/:*$//
x
s/\(=[	 ]*\).*/\1/
G
s/\n//
s/^[^=]*=[	 ]*$//
}'
fi

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
fi # test -n "$CONFIG_FILES"


eval set X "  :F $CONFIG_FILES      "
shift
for ac_tag
do
  case $ac_tag in
  :[FHLC]) ac_mode=$ac_tag; continue;;
  esac
  case $ac_mode$ac_tag in
  :[FHL]*:*);;
  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
  :[FH]-) ac_tag=-:-;;
  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
  esac
  ac_save_IFS=$IFS
  IFS=:
  set x $ac_tag
  IFS=$ac_save_IFS
  shift
  ac_file=$1
  shift

  case $ac_mode in
  :L) ac_source=$1;;
  :[FH])
    ac_file_inputs=
    for ac_f
    do
      case $ac_f in
      -) ac_f="$ac_tmp/stdin";;
      *) # Look for the file first in the build tree, then in the source tree
	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
	 # because $ac_f cannot contain `:'.
	 test -f "$ac_f" ||
	   case $ac_f in
	   [\\/$]*) false;;
	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
	   esac ||
	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
      esac
      case $ac_f in *\'*) ac_f=`$as_echo "$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 '`
	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
	`' by configure.'
    if test x"$ac_file" != x-; then
      configure_input="$ac_file.  $configure_input"
      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
$as_echo "$as_me: creating $ac_file" >&6;}
    fi
    # Neutralize special characters interpreted by sed in replacement strings.
    case $configure_input in #(
    *\&* | *\|* | *\\* )
       ac_sed_conf_input=`$as_echo "$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 ||
$as_echo X"$ac_file" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
  as_dir="$ac_dir"; as_fn_mkdir_p
  ac_builddir=.

case "$ac_dir" in
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
  case $ac_top_builddir_sub in
  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
  esac ;;
esac
ac_abs_top_builddir=$ac_pwd
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix

case $srcdir in
  .)  # We are building in place.
    ac_srcdir=.
    ac_top_srcdir=$ac_top_builddir_sub
    ac_abs_top_srcdir=$ac_pwd ;;
  [\\/]* | ?:[\\/]* )  # Absolute name.
    ac_srcdir=$srcdir$ac_dir_suffix;
    ac_top_srcdir=$srcdir
    ac_abs_top_srcdir=$srcdir ;;
  *) # Relative name.
    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_build_prefix$srcdir
    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix


  case $ac_mode in
  :F)
  #
  # CONFIG_FILE
  #

_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# If the template does not know about datarootdir, expand it.
# FIXME: This hack should be removed a few years after 2.60.
ac_datarootdir_hack=; ac_datarootdir_seen=
ac_sed_dataroot='
/datarootdir/ {
  p
  q
}
/@datadir@/p
/@docdir@/p
/@infodir@/p
/@localedir@/p
/@mandir@/p'
case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
*datarootdir*) ac_datarootdir_seen=yes;;
*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
  ac_datarootdir_hack='
  s&@datadir@&$datadir&g
  s&@docdir@&$docdir&g
  s&@infodir@&$infodir&g
  s&@localedir@&$localedir&g
  s&@mandir@&$mandir&g
  s&\\\${datarootdir}&$datarootdir&g' ;;
esac
_ACEOF

# Neutralize VPATH when `$srcdir' = `.'.
# Shell code in configure.ac might set extrasub.
# FIXME: do we really want to maintain this feature?
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_sed_extra="$ac_vpsub
$extrasub
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
s|@configure_input@|$ac_sed_conf_input|;t t
s&@top_builddir@&$ac_top_builddir_sub&;t t
s&@top_build_prefix@&$ac_top_build_prefix&;t t
s&@srcdir@&$ac_srcdir&;t t
s&@abs_srcdir@&$ac_abs_srcdir&;t t
s&@top_srcdir@&$ac_top_srcdir&;t t
s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
s&@builddir@&$ac_builddir&;t t
s&@abs_builddir@&$ac_abs_builddir&;t t
s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
$ac_datarootdir_hack
"
eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5

test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \
      "$ac_tmp/out"`; test -z "$ac_out"; } &&
  { $as_echo "$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
$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
which seems to be undefined.  Please make sure it is defined" >&2;}

  rm -f "$ac_tmp/stdin"
  case $ac_file in
  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
  esac \
  || as_fn_error $? "could not create $ac_file" "$LINENO" 5
 ;;



  esac

done # for ac_tag


as_fn_exit 0
_ACEOF
ac_clean_files=$ac_clean_files_save

test $ac_write_fail = 0 ||
  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5


# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
# Unfortunately, on DOS this fails, as config.log is still kept open
# by configure, so config.status won't be able to write to it; its
# output is simply discarded.  So we exec the FD to /dev/null,
# effectively closing config.log, so it can be properly (re)opened and
# appended to by config.status.  When coming back to configure, we
# need to make the FD available again.
if test "$no_create" != yes; then
  ac_cs_success=:
  ac_config_status_args=
  test "$silent" = yes &&
    ac_config_status_args="$ac_config_status_args --quiet"
  exec 5>/dev/null
  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
  exec 5>>config.log
  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
  # would make configure fail if this is the last instruction.
  $ac_cs_success || as_fn_exit 1
fi
if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted tools/configure.ac.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run to configure the
dnl	Makefile in this directory.
AC_INIT(man2tcl.c)
AC_PREREQ(2.69)

# Recover information that Tcl computed with its configure script.

#--------------------------------------------------------------------
#       See if there was a command-line option for where Tcl is;  if
#       not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------

DEF_VER=9.0

AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`)
if test ! -d $TCL_BIN_DIR; then
    AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
    AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
fi

. $TCL_BIN_DIR/tclConfig.sh

TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
AC_SUBST(TCL_WIN_VERSION)
CC=$TCL_CC
AC_SUBST(CC)
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)

AC_OUTPUT(Makefile tcl.hpj)
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






































































Changes to tools/encoding/big5.txt.

1
2
3
4
5
6
7
8
9
10
11
12
# big5.txt --
#
#	BIG5 to Unicode table (modified)
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# NOTE: this table has been modified to include the 7-bit ASCII
# characters that are allowed in BIG5 files.
#




|







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
5
6
7
8
9
10
11
12
# gb2312.txt --
#
#	GB2312 to Unicode table (modified)
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# NOTE: this table has been modified to include the 7-bit ASCII
# characters that are allowed in GB2312 files.
#




|







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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
## Super aggressive EOL-fixer!
##
##  Will even understand screwed up ones like CRCRLF.
##  (found in bad CVS repositories, caused by spacey developers
##   abusing CVS)
##
##  [email protected]    3:41 PM 10/12/2001
##

package provide EOL-fix 1.1

namespace eval ::EOL {
    variable outMode crlf
}

proc EOL::fix {filename {newfilename {}}} {
    variable outMode

    if {![file exists $filename]} {
	return
    }
    puts "EOL Fixing: $filename"

    file rename ${filename} ${filename}.o
    set fhnd [open ${filename}.o r]

    if {$newfilename ne ""} {
	set newfhnd [open ${newfilename} w]
    } else {
	set newfhnd [open ${filename} w]
    }

    fconfigure $newfhnd -translation [list auto $outMode]
    seek $fhnd 0 end
    set theEnd [tell $fhnd]
    seek $fhnd 0 start

    fconfigure $fhnd -translation binary -buffersize $theEnd
    set rawFile [read $fhnd $theEnd]
    close $fhnd

    regsub -all {(\r)|(\r){1,2}(\n)} $rawFile "\n" rawFile

    set lineList [split $rawFile \n]

    foreach line $lineList {
	puts $newfhnd $line
    }

    close $newfhnd
    file delete ${filename}.o
}

proc EOL::fixall {args} {
    if {[llength $args] == 0} {
	puts stderr "no files to fix"
	exit 1
    } else {
	set cmd [lreplace $args -1 -1 glob -nocomplain]
    }

    foreach f [eval $cmd] {
	if {[file isfile $f]} {fix $f}
    }
}

if {$tcl_interactive == 0 && $argc > 0} {
    if {[string index [lindex $argv 0] 0] eq "-"} {
	switch -- [lindex $argv 0] {
	    -cr   {set ::EOL::outMode cr}
	    -crlf {set ::EOL::outMode crlf}
	    -lf   {set ::EOL::outMode lf}
	    default {puts stderr "improper mode switch"; exit 1}
        }
	set argv [lrange $argv 1 end]
    }
    eval EOL::fixall $argv
} else {
    return
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































































































































































Changes to tools/genStubs.tcl.

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 by 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 --






|







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
261
262
263
264
265
266
267
268

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]
    fconfigure $out -translation lf

    while {![eof $in]} {
	set line [gets $in]
	if {[string match "*!BEGIN!*" $line]} {
	    break
	}
	puts $out $line







>

|







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
1103
1104
1105
1106
1107
1108
1109
1110
	    append text $sep "&${sub}Stubs"
	    set sep ",\n    "
	}
	append text "\n\};\n"
    }
    foreach intf [array names interfaces] {
	if {[info exists hooks($intf)]} {
	    if {[lsearch -exact $hooks($intf) $name] >= 0} {
		set root 0
		break
	    }
	}
    }

    append text "\n"







|







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
1194
1195
1196
1197
1198
1199
1200
1201
	puts stderr "usage: $argv0 outDir declFile ?declFile...?"
	exit 1
    }

    set outDir [lindex $argv 0]

    foreach file [lrange $argv 1 end] {
	source $file
    }

    foreach name [lsort [array names interfaces]] {
	puts "Emitting $name"
	emitHeader $name
    }








|







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
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
# 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 {[string length [namespace which lassign]] == 0} {
    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







|










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
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 by Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Global variables used by these scripts:
#
# state -	state variable that controls action of text proc.






|







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
15
16
17
18
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 by Kevin B. Kenny.  All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------

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 0644
	    } else {
		file attributes [file join $d2 $ftail] -readonly 1
	    }
	}
    }

    if {$::tcl_platform(platform) eq {unix}} {
	file attributes $d2 -permissions 0755
    } else {
	file attributes $d2 -readonly 1
    }

}

copyDir [file normalize [lindex $argv 0]] [file normalize [lindex $argv 1]]







|



















|







|







8
9
10
11
12
13
14
15
16
17
18
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
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 by 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]} {












|







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
25
26
27
28
29
30
31
32
#	None.
#
# Side effects:
#	Creates the message catalogs.
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------

puts stdout "TODO: output in UTF-8 in stead of using \\uhhhh sequences"
exit; # Remove those two lines after modifying this tool.








|







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
11
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 {[^\u0020-\u007e]} [string map $MAP $str] $XFORM]
    }

    ####################################################################
    #
    # compactLeadingSpaces --
    #	Converts the leading whitespace on a line into a more compact form.
    #










|
















|







1
2
3
4
5
6
7
8
9
10
11
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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
# man2help.tcl --
#
# This file defines procedures that work in conjunction with the
# man2tcl program to generate a Windows help file from Tcl manual
# entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.

#
# PASS 1
#

set man2tclprog [file join [file dirname [info script]] \
	man2tcl[file extension [info nameofexecutable]]]

proc generateContents {basename version files} {
    global curID topics
    set curID 0
    foreach f $files {
	puts "Pass 1 -- $f"
	flush stdout
	doFile $f
    }
    set fd [open [file join [file dirname [info script]] $basename$version.cnt] w]
    fconfigure $fd -translation crlf
    puts $fd ":Base $basename$version.hlp"
    foreach package [getPackages] {
	foreach section [getSections $package] {
            if {![info exists lastSection]} {
	        set lastSection {}
            }
            if {[string compare $lastSection $section]} {
	    puts $fd "1 $section"
            }
            set lastSection $section
	    set lastTopic {}
	    foreach topic [getTopics $package $section] {
		if {[string compare $lastTopic $topic]} {
		    set id $topics($package,$section,$topic)
		    puts $fd "2 $topic=$id"
		    set lastTopic $topic
		}
	    }
	}
    }
    close $fd
}


#
# PASS 2
#

proc generateHelp {basename files} {
    global curID topics keywords file id_keywords
    set curID 0

    foreach key [array names keywords] {
	foreach id $keywords($key) {
	    lappend id_keywords($id) $key
	}
    }

    set file [open [file join [file dirname [info script]] $basename.rtf] w]
    fconfigure $file -translation crlf
    puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\{\\f1\\fmodern\\fcharset0\\fprq1 Courier New\;\}\}"
    foreach f $files {
	puts "Pass 2 -- $f"
	flush stdout
	initGlobals
	doFile $f
	pageBreak
    }
    puts $file "\}"
    close $file
}

# doFile --
#
# Given a file as argument, translate the file to a tcl script and
# evaluate it.
#
# Arguments:
# file -		Name of file to translate.

proc doFile {file} {
    global man2tclprog
    if {[catch {eval [exec $man2tclprog [glob $file]]} msg]} {
	global errorInfo
	puts stderr $msg
	puts "in"
	puts $errorInfo
	exit 1
    }
}

# doDir --
#
# Given a directory as argument, translate all the man pages in
# that directory.
#
# Arguments:
# dir -			Name of the directory.

proc doDir dir {
    puts "Generating man pages for $dir..."
    foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
	doFile $f
    }
}

# process command line arguments

if {$argc < 3} {
    puts stderr "usage: $argv0 \[options\] projectName version manFiles..."
    exit 1
}

set arg 0

if {![string compare [lindex $argv $arg] "-bitmap"]} {
    set bitmap [lindex $argv [incr arg]]
    incr arg
}
set baseName [lindex $argv $arg]
set version [lindex $argv [incr arg]]
set files {}
foreach i [lrange $argv [incr arg] end] {
    set i [file join $i]
    if {[file isdir $i]} {
	foreach f [lsort [glob -directory $i "*.\[13n\]"]] {
	    lappend files $f
	}
    } elseif {[file exists $i]} {
	lappend files $i
    }
}
source [file join [file dirname [info script]] index.tcl]
generateContents $baseName $version $files
source [file join [file dirname [info script]] man2help2.tcl]
generateHelp $baseName $files
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


























































































































































































































































































Deleted tools/man2help2.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
# man2help2.tcl --
#
# This file defines procedures that are used during the second pass of
# the man page conversion.  It converts the man format input to rtf
# form suitable for use by the Windows help compiler.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Global variables used by these scripts:
#
# state -	state variable that controls action of text proc.
#
# topics -	array indexed by (package,section,topic) with value
# 		of topic ID.
#
# keywords -	array indexed by keyword string with value of topic ID.
#
# curID - 	current topic ID, starts at 0 and is incremented for
# 		each new topic file.
#
# curPkg -	current package name (e.g. Tcl).
#
# curSect -	current section title (e.g. "Tcl Built-In Commands").
#

# initGlobals --
#
# This procedure is invoked to set the initial values of all of the
# global variables, before processing a man page.
#
# Arguments:
# None.

proc initGlobals {} {
    uplevel \#0 unset state
    global state chars

    set state(paragraphPending) 0
    set state(breakPending) 0
    set state(firstIndent) 0
    set state(leftIndent) 0

    set state(inTP) 0
    set state(paragraph) 0
    set state(textState) 0
    set state(curFont) ""
    set state(startCode) "{\\b "
    set state(startEmphasis) "{\\i "
    set state(endCode) "}"
    set state(endEmphasis) "}"
    set state(noFill) 0
    set state(charCnt) 0
    set state(offset) [getTwips 0.5i]
    set state(leftMargin) [getTwips 0.5i]
    set state(nestingLevel) 0
    set state(intl) 0
    set state(sb) 0
    setTabs 0.5i

# set up international character table

    array set chars {
	o^ F4
    }
}


# beginFont --
#
# Arranges for future text to use a special font, rather than
# the default paragraph font.
#
# Arguments:
# font -		Name of new font to use.

proc beginFont {font} {
    global file state

    textSetup
    if {[string equal $state(curFont) $font]} {
	return
    }
    endFont
    puts -nonewline $file $state(start$font)
    set state(curFont) $font
}


# endFont --
#
# Reverts to the default font for the paragraph type.
#
# Arguments:
# None.

proc endFont {} {
    global state file

    if {[string compare $state(curFont) ""]} {
	puts -nonewline $file $state(end$state(curFont))
	set state(curFont) ""
    }
}


# textSetup --
#
# This procedure is called the first time that text is output for a
# paragraph.  It outputs the header information for the paragraph.
#
# Arguments:
# None.

proc textSetup {} {
    global file state

    if $state(breakPending) {
	puts $file "\\line"
    }
    if $state(paragraphPending) {
	puts $file [format "\\par\n\\pard\\fi%.0f\\li%.0f" \
			$state(firstIndent) $state(leftIndent)]
	foreach tab $state(tabs) {
	    puts $file [format "\\tx%.0f" $tab]
	}
	set state(tabs) {}
	if {$state(sb)} {
	    puts $file "\\sb$state(sb)"
	    set state(sb) 0
	}
    }
    set state(breakPending) 0
    set state(paragraphPending) 0
}


# text --
#
# This procedure adds text to the current state(paragraph).  If this is
# the first text in the state(paragraph) then header information for the
# state(paragraph) is output before the text.
#
# Arguments:
# string -		Text to output in the state(paragraph).

proc text {string} {
    global file state chars

    textSetup
    set string [string map [list \
	    "\\"	"\\\\" \
	    "\{"	"\\\{" \
	    "\}"	"\\\}" \
	    "\t"	{\tab } \
	    ''		"\\rdblquote " \
	    ``		"\\ldblquote " \
	    "\xB7"	"\\bullet " \
	    ] $string]

    # Check if this is the beginning of an international character string.
    # If so, look up the sequence in the chars table and substitute the
    # appropriate hex value.

    if {$state(intl)} {
	if {[regexp {^'([^']*)'} $string dummy ch]} {
	    if {[info exists chars($ch)]} {
		regsub {^'[^']*'} $string "\\\\'$chars($ch)" string
	    } else {
		puts stderr "Unknown international character '$ch'"
	    }
	}
	set state(intl) 0
    }

    switch $state(textState) {
	REF {
	    if {$state(inTP) == 0} {
		set string [insertRef $string]
	    }
	}
	SEE {
	    global topics curPkg curSect
	    foreach i [split $string] {
		if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} {
		    continue
		}
		if {![catch {set ref $topics($curPkg,$curSect,$i)} ]} {
		    regsub $i $string [link $i $ref] string
		}
	    }
	}
	KEY {
	    return
	}
    }
    puts -nonewline $file "$string"
}



# insertRef --
#
# This procedure looks for a string in the cross reference table and
# generates a hot-link to the appropriate topic.  Tries to find the
# nearest reference in the manual.
#
# Arguments:
# string -		Text to output in the state(paragraph).

proc insertRef {string} {
    global NAME_file curPkg curSect topics curID
    set path {}
    set string [string trim $string]
    set ref {}
    if {[info exists topics($curPkg,$curSect,$string)]} {
	set ref $topics($curPkg,$curSect,$string)
    } else {
	set sites [array names topics "$curPkg,*,$string"]
	set count [llength $sites]
	if {$count > 0} {
	    set ref $topics([lindex $sites 0])
	} else {
	    set sites [array names topics "*,*,$string"]
	    set count [llength $sites]
	    if {$count > 0} {
		set ref $topics([lindex $sites 0])
	    }
	}
    }

    if {($ref != "") && ($ref != $curID)} {
	set string [link $string $ref]
    }
    return $string
}



# macro --
#
# This procedure is invoked to process macro invocations that start
# with "." (instead of ').
#
# Arguments:
# name -		The name of the macro (without the ".").
# args -		Any additional arguments to the macro.

proc macro {name args} {
    global state file
    switch $name {
	AP {
	    if {[llength $args] != 3 && [llength $args] != 2} {
		puts stderr "Bad .AP macro: .$name [join $args " "]"
	    }
	    newPara 3.75i -3.75i
	    setTabs {1.25i 2.5i 3.75i}
	    font B
	    text [lindex $args 0]
	    tab
	    font I
	    text [lindex $args 1]
	    tab
	    font R
	    if {[llength $args] == 3} {
		text "([lindex $args 2])"
	    }
	    tab
	}
	AS {
	    # next page and previous page
	}
	br {
	    lineBreak
	}
	BS {}
	BE {}
	CE {
	    puts -nonewline $::file "\\f0\\fs20 "
	    set state(noFill) 0
	    set state(breakPending) 0
	    newPara ""
	    set state(leftIndent) [expr {$state(leftIndent) - $state(offset)}]
	    set state(sb) 80
	}
	CS {
	    # code section
	    set state(noFill) 1
	    newPara ""
	    set state(leftIndent) [expr {$state(leftIndent) + $state(offset)}]
	    set state(sb) 80
	    puts -nonewline $::file "\\f1\\fs18 "
	}
	DE {
	    set state(noFill) 0
	    decrNestingLevel
	    newPara 0i
	}
	DS {
	    set state(noFill) 1
	    incrNestingLevel
	    newPara 0i
	}
	fi {
	    set state(noFill) 0
	}
	IP {
	    IPmacro $args
	}
	LP {
	    newPara 0i
	    set state(sb) 80
	}
	ne {
	}
	nf {
	    set state(noFill) 1
	}
	OP {
	    if {[llength $args] != 3} {
		puts stderr "Bad .OP macro: .$name [join $args " "]"
	    }
	    set state(nestingLevel) 0
	    newPara 0i
	    set state(sb) 120
	    setTabs 4c
	    text "Command-Line Name:"
	    tab
	    font B
	    set x [lindex $args 0]
	    regsub -all {\\-} $x - x
	    text $x
	    lineBreak
	    font R
	    text "Database Name:"
	    tab
	    font B
	    text [lindex $args 1]
	    lineBreak
	    font R
	    text "Database Class:"
	    tab
	    font B
	    text [lindex $args 2]
	    font R
	    set state(inTP) 0
	    newPara 0.5i
	    set state(sb) 80
	}
	PP {
	    newPara 0i
	    set state(sb) 120
	}
	RE {
	    decrNestingLevel
	}
	RS {
	    incrNestingLevel
	}
	SE {
	    font R
	    set state(noFill) 0
	    set state(nestingLevel) 0
	    newPara 0i
	    text "See the "
	    font B
	    set temp $state(textState)
	    set state(textState) REF
	    text options
	    set state(textState) $temp
	    font R
	    text " manual entry for detailed descriptions of the above options."
	}
	SH {
	    SHmacro $args
	}
	SS {
	    SHmacro $args subsection
	}
	SO {
	    SHmacro "STANDARD OPTIONS"
	    set state(nestingLevel) 0
	    newPara 0i
	    setTabs {4c 8c 12c}
	    font B
	    set state(noFill) 1
	}
	so {
	    if {$args ne "man.macros"} {
		puts stderr "Unknown macro: .$name [join $args " "]"
	    }
	}
	sp {					;# needs work
	    if {$args eq ""} {
		set count 1
	    } else {
		set count [lindex $args 0]
	    }
	    while {$count > 0} {
		lineBreak
		incr count -1
	    }
	}
	ta {
	    setTabs $args
	}
	TH {
	    THmacro $args
	}
	TP {
	    TPmacro $args
	}
	UL {					;# underline
	    puts -nonewline $file "{\\ul "
	    text [lindex $args 0]
	    puts -nonewline $file "}"
	    if {[llength $args] == 2} {
		text [lindex $args 1]
	    }
	}
	VE {}
	VS {}
	QW {
	    formattedText "``[lindex $args 0]''[lindex $args 1] "
	}
	MT {
	    text "``'' "
	}
	PQ {
	    formattedText \
		"(``[lindex $args 0]''[lindex $args 1])[lindex $args 2] "
	}
	QR {
	    formattedText "``[lindex $args 0]"
	    dash
	    formattedText "[lindex $args 1]''[lindex $args 2] "
	}
	default {
	    puts stderr "Unknown macro: .$name [join $args " "]"
	}
    }
}


# link --
#
# This procedure returns the string for  a hot link to a different
# context location.
#
# Arguments:
# label -		String to display in hot-spot.
# id -			Context string to jump to.

proc link {label id} {
    return "{\\uldb $label}{\\v $id}"
}


# font --
#
# This procedure is invoked to handle font changes in the text
# being output.
#
# Arguments:
# type -		Type of font: R, I, B, or S.

proc font {type} {
    global state
    switch $type {
	P -
	R {
	    endFont
	    if {$state(textState) eq "REF"} {
		set state(textState) INSERT
	    }
	}
	C -
	B {
	    beginFont Code
	    if {$state(textState) eq "INSERT"} {
		set state(textState) REF
	    }
	}
	I {
	    beginFont Emphasis
	}
	S {
	}
	default {
	    puts stderr "Unknown font: $type"
	}
    }
}



# formattedText --
#
# Insert a text string that may also have \fB-style font changes
# and a few other backslash sequences in it.
#
# Arguments:
# text -		Text to insert.

proc formattedText {text} {
    global chars

    while {$text ne ""} {
	set index [string first \\ $text]
	if {$index < 0} {
	    text $text
	    return
	}
	text [string range $text 0 [expr {$index-1}]]
	set c [string index $text [expr {$index+1}]]
	switch -- $c {
	    f {
		font [string index $text [expr {$index+2}]]
		set text [string range $text [expr {$index+3}] end]
	    }
	    e {
		text "\\"
		set text [string range $text [expr {$index+2}] end]
	    }
	    - {
		dash
		set text [string range $text [expr {$index+2}] end]
	    }
	    & - | {
		set text [string range $text [expr {$index+2}] end]
	    }
	    ( {
		char [string range $text $index [expr {$index+3}]]
		set text [string range $text [expr {$index+4}] end]
	    }
	    default {
		puts stderr "Unknown sequence: \\$c"
		set text [string range $text [expr {$index+2}] end]
	    }
	}
    }
}


# dash --
#
# This procedure is invoked to handle dash characters ("\-" in
# troff).  It outputs a special dash character.
#
# Arguments:
# None.

proc dash {} {
    global state
    if {[string equal $state(textState) "NAME"]} {
    	set state(textState) 0
    }
    text "-"
}


# tab --
#
# This procedure is invoked to handle tabs in the troff input.
# Right now it does nothing.
#
# Arguments:
# None.

proc tab {} {
    global file

    textSetup
    puts -nonewline $file "\\tab "
}


# setTabs --
#
# This procedure handles the ".ta" macro, which sets tab stops.
#
# Arguments:
# tabList -	List of tab stops in *roff format

proc setTabs {tabList} {
    global file state

    set state(tabs) {}
    foreach arg $tabList {
	if {[string match +* $arg]} {
	    set relativeTo [lindex $state(tabs) end]
	    set arg [string range $arg 1 end]
	} else {
	    # Local left margin
	    set relativeTo [expr {$state(leftMargin) \
		    + ($state(offset) * $state(nestingLevel))}]
	}
	if {[regexp {^\\w'([^']*)'u$} $arg -> submatch]} {
	    # Magic factor!
	    set distance [expr {[string length $submatch] * 86.4}]
	} else {
	    set distance [getTwips $arg]
	}
	lappend state(tabs) [expr {round($distance + $relativeTo)}]
    }
}


# lineBreak --
#
# Generates a line break in the HTML output.
#
# Arguments:
# None.

proc lineBreak {} {
    global state
    textSetup
    set state(breakPending) 1
}



# newline --
#
# This procedure is invoked to handle newlines in the troff input.
# It outputs either a space character or a newline character, depending
# on fill mode.
#
# Arguments:
# None.

proc newline {} {
    global state

    if {$state(inTP)} {
    	set state(inTP) 0
	lineBreak
    } elseif {$state(noFill)} {
	lineBreak
    } else {
	text " "
    }
}


# pageBreak --
#
# This procedure is invoked to generate a page break.
#
# Arguments:
# None.

proc pageBreak {} {
    global file curVer
    if {[string equal $curVer ""]} {
	puts $file {\page}
    } else {
	puts $file {\par}
	puts $file {\pard\sb400\qc}
	puts $file "Last change: $curVer\\page"
    }
}


# char --
#
# This procedure is called to handle a special character.
#
# Arguments:
# name -		Special character named in troff \x or \(xx construct.

proc char {name} {
    global file state

    switch -exact $name {
        {\o} {
	    set state(intl) 1
	}
	{\ } {
	    textSetup
	    puts -nonewline $file " "
	}
	{\0} {
	    textSetup
	    puts -nonewline $file " \\emspace "
	}
	{\\} - {\e} {
	    textSetup
	    puts -nonewline $file "\\\\"
	}
	{\(+-} {
	    textSetup
	    puts -nonewline $file "\\'b1 "
	}
	{\%} - {\|} {
	}
	{\(->} {
	    textSetup
	    puts -nonewline $file "->"
	}
	{\(bu} {
	    textSetup
	    puts -nonewline $file "\\bullet "
	}
	{\(co} {
	    textSetup
	    puts -nonewline $file "\\'a9 "
	}
	{\(mi} {
	    textSetup
	    puts -nonewline $file "-"
	}
	{\(mu} {
	    textSetup
	    puts -nonewline $file "\\'d7 "
	}
	{\(em} - {\(en} {
	    textSetup
	    puts -nonewline $file "-"
	}
	{\(fm} {
	    textSetup
	    puts -nonewline $file "\\'27 "
	}
	default {
	    puts stderr "Unknown character: $name"
	}
    }
}


# macro2 --
#
# This procedure handles macros that are invoked with a leading "'"
# character instead of space.  Right now it just generates an
# error diagnostic.
#
# Arguments:
# name -		The name of the macro (without the ".").
# args -		Any additional arguments to the macro.

proc macro2 {name args} {
    puts stderr "Unknown macro: '$name [join $args " "]"
}



# SHmacro --
#
# Subsection head; handles the .SH and .SS macros.
#
# Arguments:
# name -		Section name.

proc SHmacro {argList {style section}} {
    global file state

    set args [join $argList " "]
    if {[llength $argList] < 1} {
	puts stderr "Bad .SH macro: .SH $args"
    }

    # control what the text proc does with text

    switch $args {
	NAME {set state(textState) NAME}
	DESCRIPTION {set state(textState) INSERT}
	INTRODUCTION {set state(textState) INSERT}
	"WIDGET-SPECIFIC OPTIONS" {set state(textState) INSERT}
	"SEE ALSO" {set state(textState) SEE}
	KEYWORDS {set state(textState) KEY; return}
    }

    if {$state(breakPending) != -1} {
	set state(breakPending) 1
    } else {
	set state(breakPending) 0
    }
    set state(noFill) 0
    if {[string compare "subsection" $style] == 0} {
	nextPara .25i
    } else {
	nextPara 0i
    }
    font B
    text $args
    font R
    nextPara .5i
}

# IPmacro --
#
# This procedure is invoked to handle ".IP" macros, which may take any
# of the following forms:
#
# .IP [1]		Translate to a "1Step" state(paragraph).
# .IP [x] (x > 1)	Translate to a "Step" state(paragraph).
# .IP			Translate to a "Bullet" state(paragraph).
# .IP text count	Translate to a FirstBody state(paragraph) with special
#			indent and tab stop based on "count", and tab after
#			"text".
#
# Arguments:
# argList -		List of arguments to the .IP macro.
#
# HTML limitations: 'count' in '.IP text count' is ignored.

proc IPmacro {argList} {
    global file state

    set length [llength $argList]
    foreach {text indent} $argList break
    if {$length > 2} {
	puts stderr "Bad .IP macro: .IP [join $argList " "]"
    }

    if {$length == 0} {
	set text {\(bu}
	set indent 5
    } elseif {$length == 1} {
	set indent 5
    }
    if {$text == {\(bu}} {
	set text "\xB7"
    }

    set tab [expr {$indent * 0.1}]i
    newPara $tab -$tab
    set state(sb) 80
    setTabs $tab
    formattedText $text
    tab
}

# TPmacro --
#
# This procedure is invoked to handle ".TP" macros, which may take any
# of the following forms:
#
# .TP x		Translate to an state(indent)ed state(paragraph) with the
# 			specified state(indent) (in 100 twip units).
# .TP		Translate to an state(indent)ed state(paragraph) with
# 			default state(indent).
#
# Arguments:
# argList -		List of arguments to the .IP macro.
#
# HTML limitations: 'x' in '.TP x' is ignored.

proc TPmacro {argList} {
    global state
    set length [llength $argList]
    if {$length == 0} {
	set val 0.5i
    } else {
	set val [expr {([lindex $argList 0] * 100.0)/1440}]i
    }
    newPara $val -$val
    setTabs $val
    set state(inTP) 1
    set state(sb) 120
}


# THmacro --
#
# This procedure handles the .TH macro.  It generates the non-scrolling
# header section for a given man page, and enters information into the
# table of contents.  The .TH macro has the following form:
#
# .TH name section date footer header
#
# Arguments:
# argList -		List of arguments to the .TH macro.

proc THmacro {argList} {
    global file curPkg curSect curID id_keywords state curVer bitmap

    if {[llength $argList] != 5} {
	set args [join $argList " "]
	puts stderr "Bad .TH macro: .TH $args"
    }
    incr curID
    set name	[lindex $argList 0]		;# Tcl_UpVar
    set page	[lindex $argList 1]		;# 3
    set curVer	[lindex $argList 2]		;# 7.4
    set curPkg	[lindex $argList 3]		;# Tcl
    set curSect	[lindex $argList 4]		;# {Tcl Library Procedures}

    regsub -all {\\ } $curSect { } curSect	;# Clean up for [incr\ Tcl]

    puts $file "#{\\footnote $curID}"		;# Context string
    puts $file "\${\\footnote $name}"		;# Topic title
    set browse "${curSect}${name}"
    regsub -all {[ _-]} $browse {} browse
    puts $file "+{\\footnote $browse}"		;# Browse sequence

    # Suppress duplicates
    foreach i $id_keywords($curID) {
	set keys($i) 1
    }
    foreach i [array names keys] {
	set i [string trim $i]
	if {[string length $i] > 0} {
	    puts $file "K{\\footnote $i}"	;# Keyword strings
	}
    }
    unset keys
    puts $file "\\pard\\tx3000\\sb100\\sa100\\fs24\\keepn"
    font B
    text $name
    tab
    text $curSect
    font R
    if {[info exists bitmap]} {
	# a right justified bitmap
	puts $file "\\\{bmrt $bitmap\\\}"
    }
    puts $file "\\fs20"
    set state(breakPending) -1
}

# nextPara --
#
# Set the indents for a new paragraph, and start a paragraph break
#
# Arguments:
# leftIndent -		The new left margin for body lines.
# firstIndent -		The offset from the left margin for the first line.

proc nextPara {leftIndent {firstIndent 0i}} {
    global state
    set state(leftIndent) [getTwips $leftIndent]
    set state(firstIndent) [getTwips $firstIndent]
    set state(paragraphPending) 1
}


# newPara --
#
# This procedure sets the left and hanging state(indent)s for a line.
# State(Indent)s are specified in units of inches or centimeters, and are
# relative to the current nesting level and left margin.
#
# Arguments:
# leftState(Indent) -		The new left margin for lines after the first.
# firstState(Indent) -		The new left margin for the first line of a state(paragraph).

proc newPara {leftIndent {firstIndent 0i}} {
    global state file
    if $state(paragraph) {
	puts -nonewline $file "\\line\n"
    }
    if {$leftIndent ne ""} {
	set state(leftIndent) [expr {$state(leftMargin) \
		+ ($state(offset) * $state(nestingLevel)) \
		+ [getTwips $leftIndent]}]
    }
    set state(firstIndent) [getTwips $firstIndent]
    set state(paragraphPending) 1
}


# getTwips --
#
# This procedure converts a distance in inches or centimeters into
# twips (1/1440 of an inch).
#
# Arguments:
# arg -			A number followed by "i" or "c"

proc getTwips {arg} {
    if {[scan $arg "%f%s" distance units] != 2} {
	puts stderr "bad distance \"$arg\""
	return 0
    }
    if {[string length $units] > 1} {
	puts stderr "additional characters after unit \"$arg\""
	set units [string index $units 0]
    }
    switch -- $units {
	c	{
	    set distance [expr {$distance * 567}]
	}
	i	{
	    set distance [expr {$distance * 1440}]
	}
	default {
	    puts stderr "bad units in distance \"$arg\""
	    return 0
	}
    }
    return $distance
}

# incrNestingLevel --
#
# This procedure does the work of the .RS macro, which increments
# the number of state(indent)ations that affect things like .PP.
#
# Arguments:
# None.

proc incrNestingLevel {} {
    global state

    incr state(nestingLevel)
    set oldp $state(paragraph)
    set state(paragraph) 0
    newPara 0i
    set state(paragraph) $oldp
}

# decrNestingLevel --
#
# This procedure does the work of the .RE macro, which decrements
# the number of indentations that affect things like .PP.
#
# Arguments:
# None.

proc decrNestingLevel {} {
    global state

    if {$state(nestingLevel) == 0} {
	puts stderr "Nesting level decremented below 0"
    } else {
	incr state(nestingLevel) -1
    }
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted tools/man2html.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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
#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}

# man2html.tcl --
#
# This file contains procedures that work in conjunction with the
# man2tcl program to generate a HTML files from Tcl manual entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.


# sarray -
#
# Save an array to a file so that it can be sourced.
#
# Arguments:
# file -		Name of the output file
# args -		Name of the arrays to save
#
proc sarray {file args} {
    set file [open $file w]
    foreach a $args {
	upvar $a array
	if {![array exists array]} {
	    puts "sarray: \"$a\" isn't an array"
	    break
	}

	foreach name [lsort [array names array]] {
	    regsub -all " " $name "\\ " name1
	    puts $file "set ${a}($name1) \{$array($name)\}"
	}
    }
    close $file
}


# footer --
#
# Builds footer info for HTML pages
#
# Arguments:
# packages -		List of packages to link to.

proc footer {packages} {
    lappend f "<HR>"
    set h {[}
    foreach package $packages {
	lappend h "<A HREF=\"../$package/contents.html\">$package</A>"
	lappend h "|"
    }
    lappend f [join [lreplace $h end end {]} ] " "]
    lappend f "<HR>"
    lappend f "<PRE>Copyright &#169; 1989-1994 The Regents of the University of California."
    lappend f "Copyright &#169; 1994-1996 Sun Microsystems, Inc."
    lappend f "</PRE>"
    return [join $f "\n"]
}


# doDir --
#
# Given a directory as argument, translate all the man pages in
# that directory.
#
# Arguments:
# dir -			Name of the directory.

proc doDir dir {
    foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
	do $f	;# defined in man2html1.tcl & man2html2.tcl
    }
}


# main --
#
# Main code for converting Tcl manual pages to HTML.
#
# Arguments:
# argv -		List of arguments to this script.

proc main {argv} {
    global html_dir
    # Global vars used in man2html1.tcl and man2html2.tcl
    global NAME_file KEY_file lib state curFile file inDT textState nestStk
    global curFont fontStart fontEnd noFillCount footer

    if {[llength $argv] < 2} {
	puts stderr "usage: $::argv0 html_dir tcl_dir packages..."
	puts stderr "usage: $::argv0 -clean html_dir"
	exit 1
    }

    if {[lindex $argv 0] eq "-clean"} {
	set html_dir [lindex $argv 1]
	puts -nonewline "recursively remove: $html_dir? "
	flush stdout
	if {[gets stdin] eq "y"} {
	    puts "removing: $html_dir"
	    file delete -force $html_dir
	}
	exit 0
    }

    set html_dir [lindex $argv 0]
    set tcl_dir  [lindex $argv 1]
    set packages [lrange $argv 2 end]
    set homeDir  [file dirname [info script]]

    #### need to add glob capability to packages ####

    # make sure there are doc directories for each package

    foreach i $packages {
	if {![file exists $tcl_dir/$i/doc]} {
	    puts stderr "Error: doc directory for package $i is missing"
	    exit 1
	}
	if {![file isdirectory $tcl_dir/$i/doc]} {
	    puts stderr "Error: $tcl_dir/$i/doc is not a directory"
	    exit 1
	}
    }

    # we want to start with a clean sheet

    if {[file exists $html_dir]} {
	puts stderr "Error: HTML directory already exists"
	exit 1
    } else {
	file mkdir $html_dir
    }

    set footer [footer $packages]

    # make the hyperlink arrays and contents.html for all packages

    foreach package $packages {
	file mkdir $html_dir/$package

	# build hyperlink database arrays: NAME_file and KEY_file
	#
	puts "\nScanning man pages in $tcl_dir/$package/doc..."
	uplevel \#0 [list source $homeDir/man2html1.tcl]

	doDir $tcl_dir/$package/doc

	# clean up the NAME_file and KEY_file database arrays
	#
	catch {unset KEY_file()}
	foreach name [lsort [array names NAME_file]] {
	    set file_name $NAME_file($name)
	    if {[llength $file_name] > 1} {
		set file_name [lsort $file_name]
		puts "Warning: '$name' multiply defined in: $file_name;\
			using last"
		set NAME_file($name) [lindex $file_name end]
	    }
	}
	# sarray $html_dir/$package/xref.tcl NAME_file KEY_file

	# build the contents file from NAME_file
	#
	puts "\nGenerating contents.html for $package"
	doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl

	# now translate the man pages to HTML pages
	#
	uplevel \#0 [list source $homeDir/man2html2.tcl]
	puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
	doDir $tcl_dir/$package/doc

	unset NAME_file
    }
}


if [catch { main $argv } result] {
    global errorInfo
    puts stderr $result
    puts stderr "in"
    puts stderr $errorInfo
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































































































































































































































































































Deleted tools/man2html1.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
# man2html1.tcl --
#
# This file defines procedures that are used during the first pass of the
# man page to html conversion process. It is sourced by h.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.

# Global variables used by these scripts:
#
# state -	state variable that controls action of text proc.
#
# curFile -	tail of current man page.
#
# file -	file pointer; for both xref.tcl and contents.html
#
# NAME_file -	array indexed by NAME and containing file names used
#		for hyperlinks.
#
# KEY_file -	array indexed by KEYWORD and containing file names used
#		for hyperlinks.
#
# lib -		contains package name. Used to label section in contents.html
#
# inDT -	in dictionary term.


# text --
#
# This procedure adds entries to the hypertext arrays NAME_file
# and KEY_file.
#
# DT: might do this: if first word of $dt matches $name and [llength $name==1]
# 	and [llength $dt > 1], then add to NAME_file.
#
# Arguments:
# string -		Text to index.

proc text string {
    global state curFile NAME_file KEY_file inDT

    switch $state {
	NAME {
	    foreach i [split $string ","] {
		lappend NAME_file([string trim $i]) $curFile
	    }
	}
	KEY {
	    foreach i [split $string ","] {
		lappend KEY_file([string trim $i]) $curFile
	    }
	}
	DT -
	OFF -
	DASH {}
	default {
	    puts stderr "text: unknown state: $state"
	}
    }
}


# macro --
#
# This procedure is invoked to process macro invocations that start
# with "." (instead of ').
#
# Arguments:
# name -	The name of the macro (without the ".").
# args -	Any additional arguments to the macro.

proc macro {name args} {
    switch $name {
	SH - SS {
	    global state

	    switch $args {
		NAME {
		    if {$state eq "INIT"} {
			set state NAME
		    }
		}
		DESCRIPTION {set state DT}
		INTRODUCTION {set state DT}
		KEYWORDS {set state KEY}
		default {set state OFF}
	    }

	}
	TP {
	    global inDT
	    set inDT 1
	}
	TH {
	    global lib state inDT
	    set inDT 0
	    set state INIT
	    if {[llength $args] != 5} {
		set args [join $args " "]
		puts stderr "Bad .TH macro: .$name $args"
	    }
	    set lib [lindex $args 3]				;# Tcl or Tk
	}
    }
}


# dash --
#
# This procedure is invoked to handle dash characters ("\-" in
# troff).  It only function in pass1 is to terminate the NAME state.
#
# Arguments:
# None.

proc dash {} {
    global state
    if {$state eq "NAME"} {
	set state DASH
    }
}


# newline --
#
# This procedure is invoked to handle newlines in the troff input.
# It's only purpose is to terminate a DT (dictionary term).
#
# Arguments:
# None.

proc newline {} {
    global inDT
    set inDT 0
}


# initGlobals, tab, font, char, macro2 --
#
# These procedures do nothing during the first pass.
#
# Arguments:
# None.

proc initGlobals {} {}
proc tab {} {}
proc font type {}
proc char name {}
proc macro2 {name args} {}


# doListing --
#
# Writes an ls like list to a file. Searches NAME_file for entries
# that match the input pattern.
#
# Arguments:
# file -		Output file pointer.
# pattern -		glob style match pattern

proc doListing {file pattern} {
    global NAME_file

    set max_len 0
    foreach name [lsort [array names NAME_file]] {
	set ref $NAME_file($name)
	    if [string match $pattern $ref] {
		lappend type $name
		if {[string length $name] > $max_len} {
		set max_len [string length $name]
	    }
	}
    }
    if [catch {llength $type} ] {
	puts stderr "       doListing: no names matched pattern ($pattern)"
	return
    }
    incr max_len
    set ncols [expr {90/$max_len}]
    set nrows [expr {int(ceil([llength $type] / double($ncols)))} ]

#	? max_len ncols nrows

    set index 0
    foreach f $type {
	lappend row([expr {$index % $nrows}]) $f
	incr index
    }

    puts -nonewline $file "<PRE>"
    for {set i 0} {$i<$nrows} {incr i} {
	foreach name $row($i) {
	    set str [format "%-*s" $max_len $name]
	    regsub $name $str "<A HREF=\"$NAME_file($name).html\">$name</A>" str
	    puts -nonewline $file $str
	}
	puts $file {}
    }
    puts $file "</PRE>"
}


# doContents --
#
# Generates a HTML contents file using the NAME_file array
# as its input database.
#
# Arguments:
# file -		name of the contents file.
# packageName -		string used in the title and sub-heads of the HTML
#			page. Normally name of the package without version
#			numbers.

proc doContents {file packageName} {
    global footer

    set file [open $file w]

    puts $file "<HTML><HEAD><TITLE>$packageName Manual</TITLE></HEAD><BODY>"
    puts $file "<H3>$packageName</H3>"
    doListing $file "*.1"

    puts $file "<HR><H3>$packageName Commands</H3>"
    doListing $file "*.n"

    puts $file "<HR><H3>$packageName Library</H3>"
    doListing $file "*.3"

    puts $file $footer
    puts $file "</BODY></HTML>"
    close $file
}


# do --
#
# This is the toplevel procedure that searches a man page
# for hypertext links.  It builds a data base consisting of
# two arrays: NAME_file and KEY file. It runs the man2tcl
# program to turn the man page into a script, then it evals
# that script.
#
# Arguments:
# fileName -		Name of the file to scan.

proc do fileName {
    global curFile
    set curFile [file tail $fileName]
    set file stdout
    puts "  Pass 1 -- $fileName"
    flush stdout
    if [catch {eval [exec man2tcl [glob $fileName]]} msg] {
	global errorInfo
	puts stderr $msg
	puts "in"
	puts $errorInfo
	exit 1
    }
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




































































































































































































































































































































































































































































































































Deleted tools/man2html2.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
##############################################################################
# man2html2.tcl --
#
# This file defines procedures that are used during the second pass of the man
# page to html conversion process. It is sourced by man2html.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.

# Global variables used by these scripts:
#
# NAME_file -	array indexed by NAME and containing file names used for
#		hyperlinks.
#
# textState -	state variable defining action of 'text' proc.
#
# nestStk -	stack oriented list containing currently active HTML tags (UL,
#		OL, DL). Local to 'nest' proc.
#
# inDT -	set by 'TPmacro', cleared by 'newline'. Used to insert the
#		tag while in a dictionary list <DL>.
#
# curFont -	Name of special font that is currently in use. Null means the
#		default paragraph font is being used.
#
# file -	Where to output the generated HTML.
#
# fontStart -	Array to map font names to starting sequences.
#
# fontEnd -	Array to map font names to ending sequences.
#
# noFillCount -	Non-zero means don't fill the next $noFillCount lines: force a
#		line break at each newline. Zero means filling is enabled, so
#		don't output line breaks for each newline.
#
# footer -	info inserted at bottom of each page. Normally read from the
#		xref.tcl file

##############################################################################
# initGlobals --
#
# This procedure is invoked to set the initial values of all of the global
# variables, before processing a man page.
#
# Arguments:
# None.

proc initGlobals {} {
    global file noFillCount textState
    global fontStart fontEnd curFont inPRE charCnt inTable

    nest init
    set inPRE 0
    set inTable 0
    set textState 0
    set curFont ""
    set fontStart(Code) "<B>"
    set fontStart(Emphasis) "<I>"
    set fontEnd(Code) "</B>"
    set fontEnd(Emphasis) "</I>"
    set noFillCount 0
    set charCnt 0
    setTabs 0.5i
}

##############################################################################
# beginFont --
#
# Arranges for future text to use a special font, rather than the default
# paragraph font.
#
# Arguments:
# font -		Name of new font to use.

proc beginFont font {
    global curFont file fontStart

    if {$curFont eq $font} {
	return
    }
    endFont
    puts -nonewline $file $fontStart($font)
    set curFont $font
}

##############################################################################
# endFont --
#
# Reverts to the default font for the paragraph type.
#
# Arguments:
# None.

proc endFont {} {
    global curFont file fontEnd

    if {$curFont ne ""} {
	puts -nonewline $file $fontEnd($curFont)
	set curFont ""
    }
}

##############################################################################
# text --
#
# This procedure adds text to the current paragraph. If this is the first text
# in the paragraph then header information for the paragraph is output before
# the text.
#
# Arguments:
# string -		Text to output in the paragraph.

proc text string {
    global file textState inDT charCnt inTable

    set pos [string first "\t" $string]
    if {$pos >= 0} {
    	text [string range $string 0 [expr {$pos-1}]]
    	tab
    	text [string range $string [expr {$pos+1}] end]
	return
    }
    if {$inTable} {
	if {$inTable == 1} {
	    puts -nonewline $file <TR>
	    set inTable 2
	}
	puts -nonewline $file <TD>
    }
    incr charCnt [string length $string]
    regsub -all {&} $string {\&amp;}  string
    regsub -all {<} $string {\&lt;}  string
    regsub -all {>} $string {\&gt;}  string
    regsub -all \"  $string {\&quot;}  string
    switch -exact -- $textState {
	REF {
	    if {$inDT eq ""} {
		set string [insertRef $string]
	    }
	}
	SEE {
	    global NAME_file
	    foreach i [split $string] {
		if {![regexp -nocase {^[a-z_]+} [string trim $i] i]} {
# 		    puts "Warning: $i in SEE ALSO not found"
		    continue
		}
		if {![catch { set ref $NAME_file($i) }]} {
		    regsub $i $string "<A HREF=\"$ref.html\">$i</A>" string
		}
	    }
	}
    }
    puts -nonewline $file "$string"
    if {$inTable} {
	puts -nonewline $file </TD>
    }
}

##############################################################################
# insertRef --
#
# Arguments:
# string -		Text to output in the paragraph.

proc insertRef string {
    global NAME_file self
    set path {}
    if {![catch { set ref $NAME_file([string trim $string]) }]} {
	if {"$ref.html" ne $self} {
	    set string "<A HREF=\"${path}$ref.html\">$string</A>"
#	    puts "insertRef: $self $ref.html ---$string--"
	}
    }
    return $string
}

##############################################################################
# macro --
#
# This procedure is invoked to process macro invocations that start with "."
# (instead of ').
#
# Arguments:
# name -		The name of the macro (without the ".").
# args -		Any additional arguments to the macro.

proc macro {name args} {
    switch $name {
	AP {
	    if {[llength $args] != 3} {
		puts stderr "Bad .AP macro: .$name [join $args " "]"
	    }
	    setTabs {1.25i 2.5i 3.75i}
	    TPmacro {}
	    font B
	    text "[lindex $args 0]  "
	    font I
	    text "[lindex $args 1]"
	    font R
	    text " ([lindex $args 2])"
	    newline
	}
	AS {}				;# next page and previous page
	br {
	    lineBreak
	}
	BS {}
	BE {}
	CE {
	    global file noFillCount inPRE
	    puts $file </PRE></BLOCKQUOTE>
	    set inPRE 0
	}
	CS {				;# code section
	    global file noFillCount inPRE
	    puts -nonewline $file <BLOCKQUOTE><PRE>
	    set inPRE 1
	}
	DE {
	    global file noFillCount inTable
	    puts $file </TABLE></BLOCKQUOTE>
	    set inTable 0
	    set noFillCount 0
	}
	DS {
	    global file noFillCount inTable
	    puts -nonewline $file {<BLOCKQUOTE><TABLE BORDER="0">}
	    set noFillCount 10000000
	    set inTable 1
	}
	fi {
	    global noFillCount
	    set noFillCount 0
	}
	IP {
	    IPmacro $args
	}
	LP {
	    nest decr
	    nest incr
	    newPara
	}
	ne {
	}
	nf {
	    global noFillCount
	    set noFillCount 1000000
	}
	OP {
	    global inDT file inPRE
	    if {[llength $args] != 3} {
		puts stderr "Bad .OP macro: .$name [join $args " "]"
	    }
	    nest para DL DT
	    set inPRE 1
	    puts -nonewline $file <PRE>
	    setTabs 4c
	    text "Command-Line Name:"
	    tab
	    font B
	    set x [lindex $args 0]
	    regsub -all {\\-} $x - x
	    text $x
	    newline
	    font R
	    text "Database Name:"
	    tab
	    font B
	    text [lindex $args 1]
	    newline
	    font R
	    text "Database Class:"
	    tab
	    font B
	    text [lindex $args 2]
	    font R
	    puts -nonewline $file </PRE>
	    set inDT "\n<DD>"			;# next newline writes inDT
	    set inPRE 0
	    newline
	}
	PP {
	    nest decr
	    nest incr
	    newPara
	}
	RE {
	    nest decr
	}
	RS {
	    nest incr
	}
	SE {
	    global noFillCount textState inPRE file

	    font R
	    puts -nonewline $file </PRE>
	    set inPRE 0
	    set noFillCount 0
	    nest reset
	    newPara
	    text "See the "
	    font B
	    set temp $textState
	    set textState REF
	    if {[llength $args] > 0} {
		text [lindex $args 0]
	    } else {
		text options
	    }
	    set textState $temp
	    font R
	    text " manual entry for detailed descriptions of the above options."
	}
	SH {
	    SHmacro $args
	}
	SS {
	    SHmacro $args subsection
	}
	SO {
	    global noFillCount inPRE file

	    SHmacro "STANDARD OPTIONS"
	    setTabs {4c 8c 12c}
	    set noFillCount 1000000
	    puts -nonewline $file <PRE>
	    set inPRE 1
	    font B
	}
	so {
	    if {$args ne "man.macros"} {
		puts stderr "Unknown macro: .$name [join $args " "]"
	    }
	}
	sp {					;# needs work
	    if {$args eq ""} {
		set count 1
	    } else {
		set count [lindex $args 0]
	    }
	    while {$count > 0} {
		lineBreak
		incr count -1
	    }
	}
	ta {
	    setTabs $args
	}
	TH {
	    THmacro $args
	}
	TP {
	    TPmacro $args
	}
	UL {					;# underline
	    global file
	    puts -nonewline $file "<B><U>"
	    text [lindex $args 0]
	    puts -nonewline $file "</U></B>"
	    if {[llength $args] == 2} {
		text [lindex $args 1]
	    }
	}
	VE {
#	    global file
#	    puts -nonewline $file "</FONT>"
	}
	VS {
#	    global file
#	    if {[llength $args] > 0} {
#		puts -nonewline $file "<BR>"
#	    }
#	    puts -nonewline $file "<FONT COLOR=\"GREEN\">"
	}
	QW {
	    puts -nonewline $file "&\#147;"
	    text [lindex $args 0]
	    puts -nonewline $file "&\#148;"
	    if {[llength $args] > 1} {
		text [lindex $args 1]
	    }
	}
	PQ {
	    puts -nonewline $file "(&\#147;"
	    if {[lindex $args 0] eq {\N'34'}} {
		puts -nonewline $file \"
	    } else {
		text [lindex $args 0]
	    }
	    puts -nonewline $file "&\#148;"
	    if {[llength $args] > 1} {
		text [lindex $args 1]
	    }
	    puts -nonewline $file ")"
	    if {[llength $args] > 2} {
		text [lindex $args 2]
	    }
	}
	QR {
	    puts -nonewline $file "&\#147;"
	    text [lindex $args 0]
	    puts -nonewline $file "&\#148;&\#150;&\#147;"
	    text [lindex $args 1]
	    puts -nonewline $file "&\#148;"
	    if {[llength $args] > 2} {
		text [lindex $args 2]
	    }
	}
	MT {
	    puts -nonewline $file "&\#147;&\#148;"
	}
	default {
	    puts stderr "Unknown macro: .$name [join $args " "]"
	}
    }

#	global nestStk; puts "$name [format "%-20s" $args] $nestStk"
#	flush stdout; flush stderr
}

##############################################################################
# font --
#
# This procedure is invoked to handle font changes in the text being output.
#
# Arguments:
# type -		Type of font: R, I, B, or S.

proc font type {
    global textState
    switch $type {
	P -
	R {
	    endFont
	    if {$textState eq "REF"} {
		set textState INSERT
	    }
	}
	B {
	    beginFont Code
	    if {$textState eq "INSERT"} {
		set textState REF
	    }
	}
	I {
	    beginFont Emphasis
	}
	S {
	}
	default {
	    puts stderr "Unknown font: $type"
	}
    }
}

##############################################################################
# formattedText --
#
# Insert a text string that may also have \fB-style font changes and a few
# other backslash sequences in it.
#
# Arguments:
# text -		Text to insert.

proc formattedText text {
#	puts "formattedText: $text"
    while {$text ne ""} {
	set index [string first \\ $text]
	if {$index < 0} {
	    text $text
	    return
	}
	text [string range $text 0 [expr {$index-1}]]
	set c [string index $text [expr {$index+1}]]
	switch -- $c {
	    f {
		font [string index $text [expr {$index+2}]]
		set text [string range $text [expr {$index+3}] end]
	    }
	    e {
		text \\
		set text [string range $text [expr {$index+2}] end]
	    }
	    - {
		dash
		set text [string range $text [expr {$index+2}] end]
	    }
	    | {
		set text [string range $text [expr {$index+2}] end]
	    }
	    default {
		puts stderr "Unknown sequence: \\$c"
		set text [string range $text [expr {$index+2}] end]
	    }
	}
    }
}

##############################################################################
# dash --
#
# This procedure is invoked to handle dash characters ("\-" in troff). It
# outputs a special dash character.
#
# Arguments:
# None.

proc dash {} {
    global textState charCnt
    if {$textState eq "NAME"} {
    	set textState 0
    }
    incr charCnt
    text "-"
}

##############################################################################
# tab --
#
# This procedure is invoked to handle tabs in the troff input.
#
# Arguments:
# None.

proc tab {} {
    global inPRE charCnt tabString file
#	? charCnt
    if {$inPRE == 1} {
	set pos [expr {$charCnt % [string length $tabString]}]
	set spaces [string first "1" [string range $tabString $pos end] ]
	text [format "%*s" [incr spaces] " "]
    } else {
#	puts "tab: found tab outside of <PRE> block"
    }
}

##############################################################################
# setTabs --
#
# This procedure handles the ".ta" macro, which sets tab stops.
#
# Arguments:
# tabList -	List of tab stops, each consisting of a number
#			followed by "i" (inch) or "c" (cm).

proc setTabs {tabList} {
    global file breakPending tabString

    # puts "setTabs: --$tabList--"
    set last 0
    set tabString {}
    set charsPerInch 14.
    set numTabs [llength $tabList]
    foreach arg $tabList {
	if {[string match +* $arg]} {
	    set relative 1
	    set arg [string range $arg 1 end]
	} else {
	    set relative 0
	}
	# Always operate in relative mode for "measurement" mode
	if {[regexp {^\\w'(.*)'u$} $arg content]} {
	    set distance [string length $content]
	} else {
	    if {[scan $arg "%f%s" distance units] != 2} {
		puts stderr "bad distance \"$arg\""
		return 0
	    }
	    switch -- $units {
		c {
		    set distance [expr {$distance * $charsPerInch / 2.54}]
		}
		i {
		    set distance [expr {$distance * $charsPerInch}]
		}
		default {
		    puts stderr "bad units in distance \"$arg\""
		    continue
		}
	    }
	}
	# ? distance
	if {$relative} {
	    append tabString [format "%*s1" [expr {round($distance-1)}] " "]
	    set last [expr {$last + $distance}]
	} else {
	    append tabString [format "%*s1" [expr {round($distance-$last-1)}] " "]
	    set last $distance
	}
    }
    # puts "setTabs: --$tabString--"
}

##############################################################################
# lineBreak --
#
# Generates a line break in the HTML output.
#
# Arguments:
# None.

proc lineBreak {} {
    global file inPRE
    puts $file "<BR>"
}

##############################################################################
# newline --
#
# This procedure is invoked to handle newlines in the troff input. It outputs
# either a space character or a newline character, depending on fill mode.
#
# Arguments:
# None.

proc newline {} {
    global noFillCount file inDT inPRE charCnt inTable

    if {$inDT ne ""} {
    	puts $file "\n$inDT"
    	set inDT {}
    } elseif {$inTable} {
	if {$inTable > 1} {
	    puts $file </tr>
	    set inTable 1
	}
    } elseif {$noFillCount == 0 || $inPRE == 1} {
	puts $file {}
    } else {
	lineBreak
	incr noFillCount -1
    }
    set charCnt 0
}

##############################################################################
# char --
#
# This procedure is called to handle a special character.
#
# Arguments:
# name -		Special character named in troff \x or \(xx construct.

proc char name {
    global file charCnt

    incr charCnt
#	puts "char: $name"
    switch -exact $name {
	\\0 {					;#  \0
	    puts -nonewline $file " "
	}
	\\\\ {					;#  \
	    puts -nonewline $file "\\"
	}
	\\(+- { 				;#  +/-
	    puts -nonewline $file "&#177;"
	}
	\\% {}					;#  \%
	\\| {					;#  \|
	}
	default {
	    puts stderr "Unknown character: $name"
	}
    }
}

##############################################################################
# macro2 --
#
# This procedure handles macros that are invoked with a leading "'" character
# instead of space. Right now it just generates an error diagnostic.
#
# Arguments:
# name -		The name of the macro (without the ".").
# args -		Any additional arguments to the macro.

proc macro2 {name args} {
    puts stderr "Unknown macro: '$name [join $args " "]"
}

##############################################################################
# SHmacro --
#
# Subsection head; handles the .SH and .SS macros.
#
# Arguments:
# name -		Section name.
# style -		Type of section (optional)

proc SHmacro {argList {style section}} {
    global file noFillCount textState charCnt

    set args [join $argList " "]
    if {[llength $argList] < 1} {
	puts stderr "Bad .SH macro: .$name $args"
    }

    set noFillCount 0
    nest reset

    set tag H3
    if {$style eq "subsection"} {
	set tag H4
    }
    puts -nonewline $file "<$tag>"
    text $args
    puts $file "</$tag>"

#	? args textState

    # control what the text proc does with text

    switch $args {
	NAME {set textState NAME}
	DESCRIPTION {set textState INSERT}
	INTRODUCTION {set textState INSERT}
	"WIDGET-SPECIFIC OPTIONS" {set textState INSERT}
	"SEE ALSO" {set textState SEE}
	KEYWORDS {set textState 0}
    }
    set charCnt 0
}

##############################################################################
# IPmacro --
#
# This procedure is invoked to handle ".IP" macros, which may take any of the
# following forms:
#
# .IP [1]			Translate to a "1Step" paragraph.
# .IP [x] (x > 1)		Translate to a "Step" paragraph.
# .IP				Translate to a "Bullet" paragraph.
# .IP \(bu			Translate to a "Bullet" paragraph.
# .IP text count		Translate to a FirstBody paragraph with
#				special indent and tab stop based on "count",
#				and tab after "text".
#
# Arguments:
# argList -		List of arguments to the .IP macro.
#
# HTML limitations: 'count' in '.IP text count' is ignored.

proc IPmacro argList {
    global file

    setTabs 0.5i
    set length [llength $argList]
    if {$length == 0} {
    	nest para UL LI
	return
    }
    # Special case for alternative mechanism for declaring bullets
    if {[lindex $argList 0] eq "\\(bu"} {
	nest para UL LI
	return
    }
    if {[regexp {^\[\d+\]$} [lindex $argList 0]]} {
    	nest para OL LI
	return
    }
    nest para DL DT
    formattedText [lindex $argList 0]
    puts $file "\n<DD>"
    return
}

##############################################################################
# TPmacro --
#
# This procedure is invoked to handle ".TP" macros, which may take any of the
# following forms:
#
# .TP x		Translate to an indented paragraph with the specified indent
# 			(in 100 twip units).
# .TP		Translate to an indented paragraph with default indent.
#
# Arguments:
# argList -		List of arguments to the .IP macro.
#
# HTML limitations: 'x' in '.TP x' is ignored.

proc TPmacro {argList} {
    global inDT
    nest para DL DT
    set inDT "\n<DD>"			;# next newline writes inDT
    setTabs 0.5i
}

##############################################################################
# THmacro --
#
# This procedure handles the .TH macro. It generates the non-scrolling header
# section for a given man page, and enters information into the table of
# contents. The .TH macro has the following form:
#
# .TH name section date footer header
#
# Arguments:
# argList -		List of arguments to the .TH macro.

proc THmacro {argList} {
    global file

    if {[llength $argList] != 5} {
	set args [join $argList " "]
	puts stderr "Bad .TH macro: .$name $args"
    }
    set name  [lindex $argList 0]		;# Tcl_UpVar
    set page  [lindex $argList 1]		;# 3
    set vers  [lindex $argList 2]		;# 7.4
    set lib   [lindex $argList 3]		;# Tcl
    set pname [lindex $argList 4]		;# {Tcl Library Procedures}

    puts -nonewline $file "<HTML><HEAD><TITLE>"
    text "$lib - $name ($page)"
    puts $file "</TITLE></HEAD><BODY>\n"

    puts -nonewline $file "<H1><CENTER>"
    text $pname
    puts $file "</CENTER></H1>\n"
}

##############################################################################
# newPara --
#
# This procedure sets the left and hanging indents for a line. Indents are
# specified in units of inches or centimeters, and are relative to the current
# nesting level and left margin.
#
# Arguments:
# None

proc newPara {} {
    global file nestStk

    if {[lindex $nestStk end] ne "NEW"} {
	nest decr
    }
    puts -nonewline $file "<P>"
}

##############################################################################
# nest --
#
# This procedure takes care of inserting the tags associated with the IP, TP,
# RS, RE, LP and PP macros. Only 'nest para' takes arguments.
#
# Arguments:
# op -				operation: para, incr, decr, reset, init
# listStart -		begin list tag: OL, UL, DL.
# listItem -		item tag:       LI, LI, DT.

proc nest {op {listStart "NEW"} {listItem ""} } {
    global file nestStk inDT charCnt
#	puts "nest: $op $listStart $listItem"
    switch $op {
	para {
	    set top [lindex $nestStk end]
	    if {$top eq "NEW"} {
		set nestStk [lreplace $nestStk end end $listStart]
		puts $file "<$listStart>"
	    } elseif {$top ne $listStart} {
		puts stderr "nest para: bad stack"
		exit 1
	    }
	    puts $file "\n<$listItem>"
	    set charCnt 0
	}
	incr {
	   lappend nestStk NEW
	}
	decr {
	    if {[llength $nestStk] == 0} {
		puts stderr "nest error: nest length is zero"
		set nestStk NEW
	    }
	    set tag [lindex $nestStk end]
	    if {$tag ne "NEW"} {
		puts $file "</$tag>"
	    }
	    set nestStk [lreplace $nestStk end end]
	}
	reset {
	    while {[llength $nestStk] > 0} {
		nest decr
	    }
	    set nestStk NEW
	}
	init {
	    set nestStk NEW
	    set inDT {}
	}
    }
    set charCnt 0
}

##############################################################################
# do --
#
# This is the toplevel procedure that translates a man page to HTML. It runs
# the man2tcl program to turn the man page into a script, then it evals that
# script.
#
# Arguments:
# fileName -		Name of the file to translate.

proc do fileName {
    global file self html_dir package footer
    set self "[file tail $fileName].html"
    set file [open "$html_dir/$package/$self" w]
    puts "  Pass 2 -- $fileName"
    flush stdout
    initGlobals
    if {[catch { eval [exec man2tcl [glob $fileName]] } msg]} {
	global errorInfo
	puts stderr $msg
	puts "in"
	puts stderr $errorInfo
	exit 1
    }
    nest reset
    puts $file $footer
    puts $file "</BODY></HTML>"
    close $file
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted tools/man2tcl.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
/*
 * man2tcl.c --
 *
 *	This file contains a program that turns a man page of the form used
 *	for Tcl and Tk into a Tcl script that invokes a Tcl command for each
 *	construct in the man page. The script can then be eval'ed to translate
 *	the manual entry into some other format such as MIF or HTML.
 *
 * Usage:
 *
 *	man2tcl ?fileName?
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

static char sccsid[] = "@(#) man2tcl.c 1.3 95/08/12 17:34:08";

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <errno.h>

/*
 * Imported things that aren't defined in header files:
 */

/*
 * Some <errno.h> define errno to be something complex and thread-aware; in
 * that case we definitely do not want to declare errno ourselves!
 */

#ifndef errno
extern int errno;
#endif

/*
 * Current line number, used for error messages.
 */

static int lineNumber;

/*
 * The variable below is set to 1 if an error occurs anywhere while reading in
 * the file.
 */

static int status;

/*
 * The variable below is set to 1 if output should be generated. If it's 0, it
 * means we're doing a pre-pass to make sure that the file can be properly
 * parsed.
 */

static int writeOutput;

#define PRINT(args)	if (writeOutput) { printf args; }
#define PRINTC(chr)	if (writeOutput) { putc((chr), stdout); }

/*
 * Prototypes for functions defined in this file:
 */

static void		DoMacro(char *line);
static void		DoText(char *line);
static void		QuoteText(char *string, int count);

/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This function is the main program, which does all of the work of the
 *	program.
 *
 * Results:
 *	None: exits with a 0 return status to indicate success, or 1 to
 *	indicate that there were problems in the translation.
 *
 * Side effects:
 *	A Tcl script is output to standard output. Error messages may be
 *	output on standard error.
 *
 *----------------------------------------------------------------------
 */

int
main(
    int argc,			/* Number of command-line arguments. */
    char **argv)		/* Values of command-line arguments. */
{
    FILE *f;
#define MAX_LINE_SIZE 4000
    char line[MAX_LINE_SIZE];
    char *p;

    /*
     * Find the file to read, and open it if it isn't stdin.
     */

    if (argc == 1) {
	f = stdin;
    } else if (argc == 2) {
	f = fopen(argv[1], "r");
	if (f == NULL) {
	    fprintf(stderr, "Couldn't read \"%s\": %s\n", argv[1],
		    strerror(errno));
	    exit(1);
	}
    } else {
	fprintf(stderr, "Usage: %s ?fileName?\n", argv[0]);
    }

    /*
     * Make two passes over the file. In the first pass, just check to make
     * sure we can handle everything. If there are problems, generate output
     * and stop. If everything is OK, make a second pass to actually generate
     * output.
     */

    for (writeOutput = 0; writeOutput < 2; writeOutput++) {
	lineNumber = 0;
	status = 0;
	while (fgets(line, MAX_LINE_SIZE, f) != NULL) {
	    for (p = line; *p != 0; p++) {
		if (*p == '\n') {
		    *p = 0;
		    break;
		}
	    }
	    lineNumber++;

	    if (((line[0] == '.') || (line[0] == '\'')) && (line[1] == '\\') && (line[2] == '\"')) {
		/*
		 * This line is a comment. Ignore it.
		 */

		continue;
	    }

	    if (strlen(line) >= MAX_LINE_SIZE -1) {
		fprintf(stderr, "Too long line. Max is %d chars.\n",
			MAX_LINE_SIZE - 1);
		exit(1);
	    }

	    if ((line[0] == '.') || (line[0] == '\'')) {
		/*
		 * This line is a macro invocation.
		 */

		DoMacro(line);
	    } else {
		/*
		 * This line is text, possibly with formatting characters
		 * embedded in it.
		 */

		DoText(line);
	    }
	}
	if (status != 0) {
	    break;
	}
	fseek(f, 0, SEEK_SET);
    }
    exit(status);
}

/*
 *----------------------------------------------------------------------
 *
 * DoMacro --
 *
 *	This function is called to handle a macro invocation. It parses the
 *	arguments to the macro and generates a Tcl command to handle the
 *	invocation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A Tcl command is written to stdout.
 *
 *----------------------------------------------------------------------
 */

static void
DoMacro(
    char *line)			/* The line of text that contains the macro
				 * invocation. */
{
    char *p, *end;
    int quote;

    /*
     * If there is no macro name, then just skip the whole line.
     */

    if ((line[1] == 0) || (isspace(line[1]))) {
	return;
    }

    PRINT(("macro"));
    if (*line != '.') {
	PRINT(("2"));
    }

    /*
     * Parse the arguments to the macro (including the name), in order.
     */

    p = line+1;
    while (1) {
	PRINTC(' ');
	if (*p == '"') {
	    /*
	     * The argument is delimited by quotes.
	     */

	    for (end = p+1; *end != '"'; end++) {
		if (*end == 0) {
		    fprintf(stderr,
			    "Unclosed quote in macro call on line %d.\n",
			    lineNumber);
		    status = 1;
		    break;
		}
	    }
	    QuoteText(p+1, (end-(p+1)));
	} else {
	    quote = 0;
	    for (end = p+1; (*end != 0) && (quote || !isspace(*end)); end++) {
		if (*end == '\'') {
		    quote = !quote;
		}
	    }
	    QuoteText(p, end-p);
	}
	if (*end == 0) {
	    break;
	}
	p = end+1;
	while (isspace(*p)) {
	    /*
	     * Skip empty space before next argument.
	     */

	    p++;
	}
	if (*p == 0) {
	    break;
	}
    }
    PRINTC('\n');
}

/*
 *----------------------------------------------------------------------
 *
 * DoText --
 *
 *	This function is called to handle a line of troff text. It parses the
 *	text, generating Tcl commands for text and for formatting stuff such
 *	as font changes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Tcl commands are written to stdout.
 *
 *----------------------------------------------------------------------
 */

static void
DoText(
    char *line)			/* The line of text. */
{
    char *p, *end;

    /*
     * Divide the line up into pieces consisting of backslash sequences, tabs,
     * and other text.
     */

    p = line;
    while (*p != 0) {
	if (*p == '\t') {
	    PRINT(("tab\n"));
	    p++;
	} else if (*p != '\\') {
	    /*
	     * Ordinary text.
	     */

	    for (end = p+1; (*end != '\\') && (*end != 0); end++) {
		/* Empty loop body. */
	    }
	    PRINT(("text "));
	    QuoteText(p, end-p);
	    PRINTC('\n');
	    p = end;
	} else {
	    /*
	     * A backslash sequence. There are particular ones that we
	     * understand; output an error message for anything else and just
	     * ignore the backslash.
	     */

	    p++;
	    if (*p == 'f') {
		/*
		 * Font change.
		 */

		PRINT(("font %c\n", p[1]));
		p += 2;
	    } else if (*p == '-') {
		PRINT(("dash\n"));
		p++;
	    } else if (*p == 'e') {
		PRINT(("text \\\\\n"));
		p++;
	    } else if (*p == '.') {
		PRINT(("text .\n"));
		p++;
	    } else if (*p == '&') {
		p++;
	    } else if (*p == '0') {
		PRINT(("text { }\n"));
		p++;
	    } else if (*p == '(') {
		if ((p[1] == 0) || (p[2] == 0)) {
		    fprintf(stderr, "Bad \\( sequence on line %d.\n",
			    lineNumber);
		    status = 1;
		} else {
		    PRINT(("char {\\(%c%c}\n", p[1], p[2]));
		    p += 3;
		}
	    } else if (*p == 'N' && *(p+1) == '\'') {
		int ch;

		p += 2;
		sscanf(p,"%d",&ch);
		PRINT(("text \\u%04x\n", ch));
		while(*p&&*p!='\'') p++;
		p++;
	    } else if (*p != 0) {
		PRINT(("char {\\%c}\n", *p));
		p++;
	    }
	}
    }
    PRINT(("newline\n"));
}

/*
 *----------------------------------------------------------------------
 *
 * QuoteText --
 *
 *	Copy the "string" argument to stdout, adding quote characters around
 *	any special Tcl characters so that they'll just be treated as ordinary
 *	text.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Text is written to stdout.
 *
 *----------------------------------------------------------------------
 */

static void
QuoteText(
    char *string,		/* The line of text. */
    int count)			/* Number of characters to write from
				 * string. */
{
    if (count == 0) {
	PRINT(("{}"));
	return;
    }
    for ( ; count > 0; string++, count--) {
	switch (*string) {
	case '\\':
	    if (*(string+1) == 'N' && *(string+2) == '\'') {
		int ch;

		string += 3;
		count -= 3;
		sscanf(string,"%d",&ch);
		PRINT(("\\u%04x", ch));
		while(count>0&&*string!='\'') {string++;count--;}
		continue;
	    } else if (*(string+1) == '0') {
		PRINT(("\\ "));
		string++;
		count--;
		continue;
	    }
	case '$': case '[': case '{': case ' ': case ';':
	case '"': case '\t':
	    PRINTC('\\');
	default:
	    PRINTC(*string);
	}
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
















































































































































































































































































































































































































































































































































































































































































































































































































































































Changes to tools/mkVfs.tcl.

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 0644
      	    } else {
            		file attributes [file join $d2 $ftail] -readonly 1
	          }
	      }
    }

    if {$::tcl_platform(platform) eq {unix}} {
      	file attributes $d2 -permissions 0755
    } else {
	      file attributes $d2 -readonly 1
    }
}

if {[llength $argv] < 3} {
    puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM"







|







|







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
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 by Sun Microsystems, Inc.

proc readInputFile {} {
    global inFileName
    global lineArray

    set fileId [open $inFileName r]







|







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
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 {\\\u000D} 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]
    }







|







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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
#! /bin/sh
#
# Transform text (.ps, .tcl,...) into a C string
#
# 1997/10 -- dl
#
# restart with tclsh \
exec tclsh "$0" ${1+"$@"}

# Max string length
# (some C compiler have a 2048 chars limits (so 2047 real chars with
#  the tariling 0) so we use 2000 to make the count nice)
set MAX 2000

if {$argc} {
    puts stderr "Usage: [file tail [info script]] < text > text.c"
    exit 1
}

set r [read stdin]

proc translate {what} {
    regsub -all {\\} $what {\\\\} what
    regsub -all {"} $what {\\"} what
    regsub -all "\n" $what "\\\\n\\\\\n" what;
    return $what;
}

set lg [string length $r]
if {$lg<$MAX} {
    puts "/*
 * Single part writeable string generated by str2c
 */
static char data\[\]=\"[translate $r]\";"
} else {
    puts "/*
 * Multi parts read only string generated by str2c
 */
static const char * const data\[\]= {"
    set n 1
    for {set i 0} {$i<$lg} {incr i $MAX} {
	set part [string range $r $i [expr {$i+$MAX-1}]]
	set len  [string length $part];
	puts "\t/* Start of part $n ($len characters) */"
	puts "\t\"[translate $part]\","
	puts "\t/* End of part $n */\n"
	incr n
    }
    puts "\tNULL\t/* End of data marker */\n};"
    puts "\n/* use for instance with:
    const char * const *chunk;
    for (chunk=data; *chunk; chunk++) {
        Tcl_AppendResult(interp, *chunk, (char *) NULL);
    }
*/"
}



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































































































Deleted tools/tcl.hpj.in.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
; This file is maintained by HCW. Do not modify this file directly.

[OPTIONS]
HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
CNT=tcl90.cnt
COPYRIGHT=Copyright � 2000 Ajuba Solutions
HLP=tcl90.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0

[CONFIG]
BrowseButtons()
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






































Changes to tools/tclZIC.tcl.

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 by Kevin B. Kenny.	 All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------

# Define the names of the Olson files that we need to load.
# We avoid the solar time files and the leap seconds.








|







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
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
	puts $f "\# created by $::argv0 - do not edit"
	puts $f ""
	puts $f [list set TZData(:$zoneName) $data]
	close $f
    }

    return







|







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
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
	puts $f "\# created by $::argv0 - do not edit"
	puts $f $ifCmd
	puts $f $setCmd
	close $f
    }

    return







|







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
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
##
## templating
##
proc indexfile {} {
    if {[info exists ::TARGET] && $::TARGET eq "devsite"} {
	return "index.tml"
    } else {
	return "contents.htm"
    }
}

proc copyright {copyright {level {}}} {
    # We don't actually generate a separate copyright page anymore
    #set page "${level}copyright.htm"
    #return "<A HREF=\"$page\">Copyright</A> &#169; [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 &copy; [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 DOCTYPE {} {
    return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
}

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]\n<HTML>\n<HEAD><TITLE>$title</TITLE>\n[CSS $level]</HEAD>\n"
    foreach {uptitle url} $args {
	set header "<a href=\"$url\">$uptitle</a> <small>&gt;</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 htmlize-text {text {charmap {}}} {
    # contains some extras for use in nroff->html processing
    # build on the list passed in, if any
    lappend charmap \
	"&ndash;" "&ndash;" \
	{&}	{&amp;} \
	{\\}	"&#92;" \
	{\e}	"&#92;" \
	{\ }	{&nbsp;} \
	{\|}	{&nbsp;} \
	{\0}	{ } \
	\"	{&quot;} \
	{<}	{&lt;} \
	{>}	{&gt;} \
	\u201c "&#8220;" \
	\u201d "&#8221;"

    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" \




	    {\(+-}	"&#177;" \



	    {\(co}	"&copy;" \
	    {\(em}	"&#8212;" \

	    {\(en}	"&#8211;" \
	    {\(fm}	"&#8242;" \






	    {\(mc}	"&#181;" \












	    {\(mu}	"&#215;" \









	    {\(mi}	"&#8722;" \








	    {\(->}	"<font size=\"+1\">&#8594;</font>" \

	    {\fP}	{\fR} \
	    {\.}	. \
	    {\(bu}	"&#8226;" \

	    ]
    # This might make a few invalid mappings, but we don't use them
    foreach c {a e i o u y A E I O U Y} {
	foreach {prefix suffix} {
	    o ring / slash : uml ' acute ^ circ ` grave
	} {
	    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 \







|





|
|










|












<
<
<
<






|



|







|


|















>
>
>
>















|
|












>
>
>
>
|
>
>
>

|
>
|
|
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
>


|
>


|

|


>











|


|


|


|


|







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> &copy; [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 &copy; [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>&gt;</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 \
	"&ndash;" "&ndash;" \
	{&}	{&amp;} \
	{\\}	"&#92;" \
	{\e}	"&#92;" \
	{\ }	{&nbsp;} \
	{\|}	{&nbsp;} \
	{\0}	{ } \
	\"	{&quot;} \
	{<}	{&lt;} \
	{>}	{&gt;} \
	\u201C "&ldquo;" \
	\u201D "&rdquo;"

    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!}	"&iexcl;" \
	    {\(ct}	"&cent;" \
	    {\(Po}	"&pound;" \
	    {\(Cs}	"&curren;" \
	    {\(Ye}	"&yen;" \
	    {\(bb}	"&brvbar;" \
	    {\(sc}	"&sect;" \
	    {\(ad}	"&die;" \
	    {\(co}	"&copy;" \
	    {\(Of}	"&ordf;" \
	    {\(Fo}	"&laquo;" \
	    {\(no}	"&not;" \
	    {\(rg}	"&reg;" \
	    {\(a-}	"&macr;" \
	    {\(de}	"&deg;" \
	    {\(+-}	"&plusmn;" \
	    {\(S2}	"&sup2;" \
	    {\(S3}	"&sup3;" \
	    {\(aa}	"&acute;" \
	    {\(mc}	"&micro;" \
	    {\(ps}	"&para;" \
	    {\(pc}	"&middot;" \
	    {\(ac}	"&cedil;" \
	    {\(S1}	"&sup1;" \
	    {\(Om}	"&ordm;" \
	    {\(Fc}	"&raquo;" \
	    {\(14}	"&frac14;" \
	    {\(12}	"&frac12;" \
	    {\(34}	"&frac34;" \
	    {\(r?}	"&iquest;" \
	    {\(AE}	"&AElig;" \
	    {\(-D}	"&ETH;" \
	    {\(mu}	"&times;" \
	    {\(TP}	"&THORN;" \
	    {\(ss}	"&szlig;" \
	    {\(ae}	"&aelig;" \
	    {\(Sd}	"&eth;" \
	    {\(di}	"&divide;" \
	    {\(Tp}	"&thorn;" \
	    {\(em}	"&mdash;" \
	    {\(en}	"&ndash;" \
	    {\(fm}	"&prime;" \
	    {\(mi}	"&minus;" \
	    {\(.i}	"&imath;" \
	    {\(.j}	"&jmath;" \
	    {\(Fn}	"&fnof;" \
	    {\(OE}	"&OElig;" \
	    {\(oe}	"&oelig;" \
	    {\(IJ}	"&IJlig;" \
	    {\(ij}	"&ijlig;" \
	    {\(<-}	"<font size=\"+1\">&larr;</font>" \
	    {\(->}	"<font size=\"+1\">&rarr;</font>" \
	    {\(eu}	"&euro;" \
	    {\fP}	{\fR} \
	    {\.}	. \
	    {\(bu}	"&bull;" \
	    {\*(qo}	"&ocirc;" \
	    ]
    # 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
329
330
331
332
333
334
335
336
337
##
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).htm#$here\" NAME=\"$there\">$text</A>"
    return "<A NAME=\"$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" ||







|
|







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
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
    # 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).htm#$here\">$switch, $name, $class</A>"
    lappend manual(section-toc) \
	"<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
    return "<A NAME=\"$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.htm#$other\">$name</A>"
    return "<A HREF=\"$page.htm#$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
	    }







|

|
|





|






|
|








|
|







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
413
414
415
416
417
418
419
420
421
422
423
424
	}
	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 {







|
|
|
|
|







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
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
		    }
		} 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







|
|










|



|






|







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
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
		    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 {"&#8226;" 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 {"&#8226;" 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]} {







|










|





|












|



|

|
|


|
|
|
|
|


















|

|

|
|
|

|







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 {"&bull;" 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 {"&bull;" 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
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
			} 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
			}







|
|




|




|







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
620
621
622
623
624
625
626
627
			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"
	}
    }







|







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
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
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 &mdash; $tail"
    # output line to long table of contents
    lappend manual(section-toc) "<DL><DD>$head &mdash; $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).htm) $line
}

##
## build a cross-reference link if appropriate
##
proc cross-reference {ref} {
    global manual remap_link_target







|









|







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 &mdash; $tail"
    # output line to long table of contents
    lappend manual(section-toc) "<dl><dd>$head &mdash; $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
678
679
680
681
682
683
684
685
	}
    } 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)







|







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
700
701
702
703
704
705
706
707
	    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).htm\">$ref</A>"
	    }
	}
	if {$lref in {end}} {
	    # no good place to send this tcl token?
	}
	return $ref
    }







|







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
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
    ## 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.htm\">$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.htm\">$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.htm\">$ref</A>"
	}
	puts stderr "multiple cross reference to $ref in $manref from $manual(wing-file)/$mantail"
	return $ref
    }
    ##
    ## exceptions, sigh, to the rule
    ##







|





|



|







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
762
763
764
765
766
767
768
769
	&& $lref in $exclude_refs_map($mantail)
    } {
	return $ref
    }
    ##
    ## return the cross reference
    ##
    return "<A HREF=\"../$manref.htm\">$ref</A>"
}

##
## reference generation errors
##
proc reference-error {msg text} {
    global manual







|







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
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
    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}







|










|

|







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
879
880
881
882
883
884
885
886
887
		    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]







|
|







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
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
		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 {" " "&nbsp;"} $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
		}







|




















|









|

|



















|


















|












|

|

|



|

















|
|

|
|







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 {" " "&nbsp;"} $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
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
			    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).htm]
			    set initial [string toupper [string index $key 0]]
			    lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
			}
			man-puts [join $keys {, }]
		    }
		    return
		}
	    }
	    if {[next-op-is .IP rest]} {







|

|







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
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
		    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







|
|


|

|
|










|






|










|

|










|








|


|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|







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
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
## 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]

    # 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







|
|









>




|

|







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
1563
1564
1565
1566
1567
1568
1569
1570
	    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."







|







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
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
    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.htm)]} {
	    set tooltip $manual(tooltip-$manual(wing-file)/$tail.htm)
	    set tooltip [string map {[ {\[} ] {\]} $ {\$} \\ \\\\} $tooltip]
	    regsub {^[^-]+-\s*(.)} $tooltip {[string totitle \1]} tooltip
	    append rows([expr {$n%$nrows}]) \
		"<td> <a href=\"$tail.htm\" title=\"[subst $tooltip]\">$name</a> </td>"
	} else {
	    append rows([expr {$n%$nrows}]) \
		"<td> <a href=\"$tail.htm\">$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 {







|
|



|


|













|







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
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\
	tclsh9.0 (or the equivalent tclsh90.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.
#






|







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
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]
		}
	    }
	}
    }







|







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
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 $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 $tcldir 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 $tkdir"
    }

    puts "verbose messages are [expr {$verbose ? {on} : {off}}]"

    # the title for the man pages overall
    global overall_title
    set overall_title ""







|





|



|







|


|




|



|







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
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 #999;
    }
    css-style ".keylist dt" { font-weight: bold; }
    css-style ".keylist dd" ".arguments dd" {
	margin-left: 20em;
	padding: 2px;
	border-top: 1px solid #999;
    }
    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;







|








|



















|





|
|





|













|





|


|







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
337
338
339
340
341
342
343
344
##
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]
    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
	}







>




>

|







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
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
    ##
    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]} {
	    lappend keyheader "<A HREF=\"$a.htm\">$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.htm w]

	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=\"$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} {







>








|





|







|
>




|


|
|









|

|


|

|


|




|





|
|


|







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
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
		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).htm w]

	    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 {







|
>

















|







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



744


745
746
747
748
749
750
751
	    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 {



		set f [open [file join $pkgsDir $dir configure.ac]]


		foreach line [split [read $f] \n] {
		    if {2 == [scan $line \
			    { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} {
			set description [list $n $v]
			break
		    }
		}







>
>
>
|
>
>







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
804
805
806
807
808
809
810
811
812
813
    #
    # 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} {







|

|







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
3
4
5
6
7
8
9
10
#include <tcl.h>

extern DLLEXPORT Tcl_PackageInitProc Tsdperf_Init;

static Tcl_ThreadDataKey key;

typedef struct {
    Tcl_WideInt value;
} TsdPerf;



|







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
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 by 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








|







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
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
    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 by 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.







|







|







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
343
344
345
346
347
348


349
350
351
352
353
354
355
	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_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 \


	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 \







|





>
>







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
674

675
676
677
678
679
680
681
	$(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


DL_SRCS = \
	$(UNIX_DIR)/tclLoadAix.c \
	$(UNIX_DIR)/tclLoadDl.c \
	$(UNIX_DIR)/tclLoadDl2.c \
	$(UNIX_DIR)/tclLoadDld.c \
	$(UNIX_DIR)/tclLoadDyld.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
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794

795



796
797
798
799
800
801
802
	@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}/reg
	@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 \

	    cat ${TCL_ZIP_FILE} >> ${LIB_FILE}; \



	    ${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 ); \







|














>

>
>
>







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
817
818
819
820









821
822
823
824
825
826
827
# 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}
	${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} \
		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
		${CC_SEARCH_FLAGS} -o ${TCL_EXE}










# 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







|



>
>
>
>
>
>
>
>
>







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
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
	    @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-zipfs-shared: libraries
	@for i in "$(SCRIPT_INSTALL_DIR)"; do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
	    fi; \
	done
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"
	@for i in $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	done

install-libraries-zipfs-static: install-libraries-zipfs-shared
	$(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"

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; \







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
	@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.3 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.3.tm"
	@echo "Installing package platform 1.0.14 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/platform-1.0.14.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







|

|
|

|







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
1473
1474
1475
1476
1477
1478
1479
1480
		-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)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_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







<







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
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536

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_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
		-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)







<

<







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
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786

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
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclEpollNotfy.c

tclKqueueNotfy.o: $(UNIX_DIR)/tclKqueueNotfy.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclKqueueNotfy.c

tclSelectNotfy.o: $(UNIX_DIR)/tclSelectNotfy.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







|


|


|







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










1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923

#--------------------------------------------------------------------------
# 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 $(GENERIC_DIR)/tclStubLib.c

tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c

tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclOOStubLib.c

.c.o:
	$(CC) -c $(CC_SWITCHES) $<

#--------------------------------------------------------------------------
# Minizip implementation
#--------------------------------------------------------------------------







>
>
>
>
>
>
>
>
>
>
|


|


|







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
2223
2224
2225
2226
2227
2228
2229
2230

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 reg 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







|







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
2305
2306
2307
2308
2309
2310
2311
2312
	    | ( 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
	$(DIST_INSTALL_DATA) $(TOP_DIR)/win/tcl.hpj.in $(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 \







>
>
>
>
>
>
>
>
>
>
>
>
>












<







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
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
	$(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)/Makefile.in $(TOOL_DIR)/README \
		$(TOOL_DIR)/configure $(TOOL_DIR)/configure.ac \
		$(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \
		$(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \
		$(DISTDIR)/tools
	chmod 755 $(DISTDIR)/tools/checkLibraryDoc.tcl \
		$(DISTDIR)/tools/configure $(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




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) )







|
<
|
<
|

|











>
>
>







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
2401
2402
2403
2404
.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: install-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile

#--------------------------------------------------------------------------
# DO NOT DELETE THIS LINE -- make depend depends on it.







|



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
3
4
5
6
7
8
9
10
11
12
13
14
15
16

17

18
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
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for tcl 9.0.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##

# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh

if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :

  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac
fi










as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '


    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi

  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'









fi





# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; 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


# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

# 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

  test -z "$as_dir" && as_dir=.



    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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH

# 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


|


|










>
|
>






|









>
>
>
>
>
>
>
>



<
<
<
<
<
<
<
<
|
|
<
|
|
<
<
<
<
<
<
|
<
<
<
<
<
<
<
|
>
>
|
<
<
>
|
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>


|








<
<
<
<
<
<
<








>
|
>
>
>
|











|



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
as_fn_exit 255
  fi
  # We don't want this to propagate to other subprocesses.
          { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :


  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '\${1+\"\$@\"}'='\"\$@\"'
  setopt NO_GLOB_SUBST
else
  case \`(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
  exitcode=1; echo positional parameters were not saved.
fi
test x\$exitcode = x0 || 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_have_required=no
fi
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :


else
  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

  test -z "$as_dir" && as_dir=.



  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_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :

  CONFIG_SHELL=$as_shell as_have_required=yes
		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :

  break 2
fi
fi
	   done;;
       esac
  as_found=false
done





$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :

  CONFIG_SHELL=$SHELL as_have_required=yes
fi; }
IFS=$as_save_IFS



      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'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
fi

    if test x$as_have_required = xno; then :

  $as_echo "$0: This script requires a shell more modern than all"
  $as_echo "$0: the shells that I found on your system."
  if test x${ZSH_VERSION+set} = xset ; then
    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
  else
    $as_echo "$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







|
|




|
>
>






|



















|
>

|



>
>






|
>

|


|
>

|





>
|
>
>
>





|

|
>

|
>







>
>
>
>
>
|
|
>

|
<
>


|
>

















|



|
>
|
|
|
|
|

|







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
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset


# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit









# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(
      *\'*) as_qdir=`$as_echo "$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 ||
$as_echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q







>


















>
>
>
>
>
>
>
>














|








|







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
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
} # 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_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_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith










# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
{
  as_status=$1; test $as_status -eq 0 && as_status=1
  if test "$4"; then
    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$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







|
>




|











|
>




|






>
>
>
>
>
>
>
>











|

|







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
442
443
444
445
446
447
448
449
  as_dirname=false
fi

as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
	    s//\1/
	    q







|







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
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
      N
      :loop
      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
      t loop
      s/-\n.*//
    ' >$as_me.lineno &&
  chmod +x "$as_me.lineno" ||
    { $as_echo "$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
}





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







|













>
>
>
>












>
>
>
>
>
>
>







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
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
PACKAGE_VERSION='9.0'
PACKAGE_STRING='tcl 9.0'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif
#ifdef STDC_HEADERS
# include <stdlib.h>
# include <stddef.h>
#else
# ifdef HAVE_STDLIB_H
#  include <stdlib.h>
# endif
#endif
#ifdef HAVE_STRING_H
# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
#  include <memory.h>
# endif
# include <string.h>
#endif
#ifdef HAVE_STRINGS_H
# include <strings.h>
#endif
#ifdef HAVE_INTTYPES_H
# include <inttypes.h>
#endif
#ifdef HAVE_STDINT_H
# include <stdint.h>
#endif









#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif"


ac_subst_vars='DLTEST_SUFFIX
DLTEST_LD
EXTRA_TCLSH_LIBS
EXTRA_BUILD_HTML
EXTRA_INSTALL_BINARIES
EXTRA_INSTALL
EXTRA_APP_CC_SWITCHES







|
|
|

|
<
<
<

<
<
<
<
<


<
<
<


<
<
<






>
>
>
>
>
>
>
>
>




>







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
785
786
787
788
789
790
791
792
793
enable_corefoundation
enable_load
enable_symbols
enable_langinfo
enable_dll_unloading
with_tzdata
enable_dtrace
enable_zipfs
enable_framework
'
      ac_precious_vars='build_alias
host_alias
target_alias
CC
CFLAGS
LDFLAGS







|
|







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
864
865
866
867
868
869
870
871
872

  case $ac_option in
  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
  *=)   ac_optarg= ;;
  *)    ac_optarg=yes ;;
  esac

  # Accept the important Cygnus configure options, so we can diagnose typos.

  case $ac_dashdash$ac_option in
  --)
    ac_dashdash=yes ;;

  -bindir | --bindir | --bindi | --bind | --bin | --bi)
    ac_prev=bindir ;;
  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)







<
<







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
906
907
908
909
910
911
912
913
914
915
  | --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=`$as_echo "$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







|

|







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
932
933
934
935
936
937
938
939
940
941
  -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=`$as_echo "$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







|

|







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
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
  -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=`$as_echo "$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=`$as_echo "$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







|

|













|

|







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
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
      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.
    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
      $as_echo "$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" ;;
    *)     $as_echo "$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
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;;







|

|















|







|







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
1280
1281
1282
1283
1284
1285
1286
1287
  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 ||
$as_echo X"$as_myself" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q







|







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
1425
1426
1427

1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
  --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-zipfs          build with Zipfs support (default: on)
  --enable-framework      package shared libraries in MacOSX frameworks
                          (default: off)


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







<


>




|
<







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
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
      { 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=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$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







|

|







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
1498

1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554

1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594

1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612

































1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636

1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817

1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862

1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883

1884
1885
1886
1887

1888
1889
1890


1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909

1910
1911
1912
1913
1914

1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931

1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948

1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961

1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975











































1976
1977
1978
1979
1980
1981
1982
1983
1984
1985

1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002

2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018

2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032




















2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
    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 guested configure.

    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
      $as_echo "$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.69

Copyright (C) 2012 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
  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\""
$as_echo "$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
  $as_echo "$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_echo "$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$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\""
$as_echo "$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
  $as_echo "$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_echo "$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_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\""
$as_echo "$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
  $as_echo "$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_echo "$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_header_mongrel LINENO HEADER VAR INCLUDES
# -------------------------------------------------------
# Tests whether HEADER exists, giving a warning if it cannot be compiled using
# the include files in INCLUDES and setting the cache variable VAR
# accordingly.
ac_fn_c_check_header_mongrel ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  if eval \${$3+:} false; then :
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
else
  # Is the header compilable?
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
$as_echo_n "checking $2 usability... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
#include <$2>
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  ac_header_compiler=yes
else
  ac_header_compiler=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
$as_echo "$ac_header_compiler" >&6; }

# Is the header present?
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
$as_echo_n "checking $2 presence... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <$2>
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :
  ac_header_preproc=yes
else
  ac_header_preproc=no
fi
rm -f conftest.err conftest.i conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
$as_echo "$ac_header_preproc" >&6; }

# So?  What about this header?
case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
  yes:no: )
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
    ;;
  no:yes:* )
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     check for missing prerequisite headers?" >&5
$as_echo "$as_me: WARNING: $2:     check for missing prerequisite headers?" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&5
$as_echo "$as_me: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
    ;;
esac
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  eval "$3=\$ac_header_compiler"
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_header_mongrel

# ac_fn_c_try_run LINENO
# ----------------------
# Try to link 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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; }; then :
  ac_retval=0
else
  $as_echo "$as_me: program exited with status $ac_status" >&5
       $as_echo "$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_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
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  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
  eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_header_compile

# 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
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }

if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  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.
    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
    <limits.h> exists even on freestanding compilers.  */

#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif

#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 ()
{
return $2 ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  eval "$3=yes"
else
  eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$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

  as_decl_name=`echo $2|sed 's/ *(.*//'`
  as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
$as_echo_n "checking whether $as_decl_name is declared... " >&6; }

if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else


  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main ()
{
#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
  eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }

if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  eval "$3=no"
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main ()
{
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 ()
{
if (sizeof (($2)))
	    return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :


else
  eval "$3=yes"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_type












































# 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
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5
$as_echo_n "checking for $2.$3... " >&6; }

if eval \${$4+:} false; then :
  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$5
int
main ()
{
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
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$5
int
main ()
{
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
  eval "$4=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$4
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_member




















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.69.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
## Platform. ##







|
>







|









|

|
















|






|







|



|
>

|
|















|






|







|






>
|

|
|














>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












|







|



>
|

|
|









<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






|
|
>
|
|
|







|
<
<

<
|
<
<
<
<

















|






|
>

|


|



|
|











>
|

|
|
>
|
|
|
>
>




|













|
>

|


|
>


|
|











|
|
>
|
|
|





|







|
>




|







|
>

|


|

|


|
|



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








|
|
>
|
|
|




|








|
>

|




|








|
>

|


|

|


|
|



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|

|







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

2073



2074
2075
2076
2077
2078
2079
2080
2081

_ASUNAME

as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS

  test -z "$as_dir" && as_dir=.



    $as_echo "PATH: $as_dir"
  done
IFS=$as_save_IFS

} >&5

cat >&5 <<_ACEOF








>
|
>
>
>
|







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
2109
2110
2111
2112
2113
2114
2115
2116
  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=`$as_echo "$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.







|







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
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167

# 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

    $as_echo "## ---------------- ##
## 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_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$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







>
>




|










|
|







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
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
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
      ;;
    esac |
    sort
)
    echo

    $as_echo "## ----------------- ##
## Output variables. ##
## ----------------- ##"
    echo
    for ac_var in $ac_subst_vars
    do
      eval ac_val=\$$ac_var
      case $ac_val in
      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      esac
      $as_echo "$ac_var='\''$ac_val'\''"
    done | sort
    echo

    if test -n "$ac_subst_files"; then
      $as_echo "## ------------------- ##
## File substitutions. ##
## ------------------- ##"
      echo
      for ac_var in $ac_subst_files
      do
	eval ac_val=\$$ac_var
	case $ac_val in
	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	esac
	$as_echo "$ac_var='\''$ac_val'\''"
      done | sort
      echo
    fi

    if test -s confdefs.h; then
      $as_echo "## ----------- ##
## confdefs.h. ##
## ----------- ##"
      echo
      cat confdefs.h
      echo
    fi
    test "$ac_signal" != 0 &&
      $as_echo "$as_me: caught signal $ac_signal"
    $as_echo "$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

$as_echo "/* confdefs.h */" > confdefs.h

# Predefined preprocessor variables.

cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_URL "$PACKAGE_URL"
_ACEOF


# Let the site file select an alternate cache file if it wants to.
# Prefer an explicitly selected file to automatically selected ones.
ac_site_file1=NONE
ac_site_file2=NONE
if test -n "$CONFIG_SITE"; then
  # We do not want a PATH search for config.site.
  case $CONFIG_SITE in #((
    -*)  ac_site_file1=./$CONFIG_SITE;;
    */*) ac_site_file1=$CONFIG_SITE;;
    *)   ac_site_file1=./$CONFIG_SITE;;
  esac
elif test "x$prefix" != xNONE; then
  ac_site_file1=$prefix/share/config.site
  ac_site_file2=$prefix/etc/config.site
else
  ac_site_file1=$ac_default_prefix/share/config.site
  ac_site_file2=$ac_default_prefix/etc/config.site
fi

for ac_site_file in "$ac_site_file1" "$ac_site_file2"
do
  test "x$ac_site_file" = xNONE && continue





  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
$as_echo "$as_me: loading site script $ac_site_file" >&6;}
    sed 's/^/| /' "$ac_site_file" >&5
    . "$ac_site_file" \
      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
$as_echo "$as_me: loading cache $cache_file" >&6;}
    case $cache_file in
      [\\/]* | ?:[\\/]* ) . "$cache_file";;
      *)                      . "./$cache_file";;
    esac
  fi
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
$as_echo "$as_me: creating cache $cache_file" >&6;}
  >$cache_file
fi































































































































































































































































































































# 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,)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
      ac_cache_corrupted=: ;;
    ,set)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
$as_echo "$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
	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
	  ac_cache_corrupted=:
	else
	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
	  eval $ac_var=\$ac_old_val
	fi
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
$as_echo "$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=`$as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}

  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
fi
## -------------------- ##
## Main body of script. ##
## -------------------- ##

ac_ext=c
ac_cpp='$CPP $CPPFLAGS'







|







|

|




|







|

|





|







|
|













|



<
|
<

<
|
<

<
|
<

<
|
<

<
|
<

<
|
<




<
<

<
|
<
<
<
<

|
<

|
<

>
|

|
>
>
>
>
>
|
|
|


|
|









|
|






|
|



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










|
|


|
|








|
|


|
|


|
|
|
|





|









|
|
|
|
>
|







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
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
TCL_SRC_DIR="`cd "$srcdir"/..; pwd`"

#------------------------------------------------------------------------
# Compress and/or soft link the manpages?
#------------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use symlinks for manpages" >&5
$as_echo_n "checking whether to use symlinks for manpages... " >&6; }
    # Check whether --enable-man-symlinks was given.
if test "${enable_man_symlinks+set}" = set; then :

  enableval=$enable_man_symlinks; test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks"
else
  enableval="no"
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
$as_echo "$enableval" >&6; }

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to compress the manpages" >&5
$as_echo_n "checking whether to compress the manpages... " >&6; }
    # Check whether --enable-man-compression was given.
if test "${enable_man_compression+set}" = set; 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
  enableval="no"
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
$as_echo "$enableval" >&6; }
    if test "$enableval" != "no"; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for compressed file suffix" >&5
$as_echo_n "checking for compressed file suffix... " >&6; }
	touch TeST
	$enableval TeST
	Z=`ls TeST* | sed 's/^....//'`
	rm -f TeST*
	MAN_FLAGS="$MAN_FLAGS --extension $Z"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $Z" >&5
$as_echo "$Z" >&6; }
    fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to add a package name suffix for the manpages" >&5
$as_echo_n "checking whether to add a package name suffix for the manpages... " >&6; }
    # Check whether --enable-man-suffix was given.
if test "${enable_man_suffix+set}" = set; 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
  enableval="no"
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi

  if test "x$ac_ct_CC" = x; then
    CC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    CC=$ac_ct_CC
  fi








































































































fi

fi


test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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.
$as_echo "$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; 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\""
$as_echo "$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
  $as_echo "$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 ()
{

  ;
  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.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
$as_echo_n "checking whether the C compiler works... " >&6; }
ac_link_default=`$as_echo "$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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link_default") 2>&5
  ac_status=$?
  $as_echo "$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+set}" = set && 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
  ac_file=''
fi
if test -z "$ac_file"; then :

  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
$as_echo_n "checking for C compiler default output file name... " >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
$as_echo_n "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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$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_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
$as_echo "$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 ()
{
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.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
$as_echo_n "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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  $as_echo "$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
	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot run C compiled programs.
If you meant to cross compile, use \`--host'.
See \`config.log' for more details" "$LINENO" 5; }
    fi
  fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
$as_echo "$cross_compiling" >&6; }

rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
ac_clean_files=$ac_clean_files_save
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
$as_echo_n "checking for suffix of object files... " >&6; }
if ${ac_cv_objext+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_compile") 2>&5
  ac_status=$?
  $as_echo "$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_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
$as_echo "$ac_cv_objext" >&6; }
OBJEXT=$ac_cv_objext
ac_objext=$OBJEXT
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
if ${ac_cv_c_compiler_gnu+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{
#ifndef __GNUC__
       choke me
#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  ac_compiler_gnu=yes
else
  ac_compiler_gnu=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
$as_echo "$ac_cv_c_compiler_gnu" >&6; }


if test $ac_compiler_gnu = yes; then
  GCC=yes
else
  GCC=
fi
ac_test_CFLAGS=${CFLAGS+set}
ac_save_CFLAGS=$CFLAGS
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
$as_echo_n "checking whether $CC accepts -g... " >&6; }
if ${ac_cv_prog_cc_g+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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 ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  ac_cv_prog_cc_g=yes
else
  CFLAGS=""
      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :


else
  ac_c_werror_flag=$ac_save_c_werror_flag
	 CFLAGS="-g"
	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  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.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
   ac_c_werror_flag=$ac_save_c_werror_flag
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
$as_echo "$ac_cv_prog_cc_g" >&6; }
if test "$ac_test_CFLAGS" = set; 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }




























































































if ${ac_cv_prog_cc_c89+:} false; then :

  $as_echo_n "(cached) " >&6
else
  ac_cv_prog_cc_c89=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdarg.h>
#include <stdio.h>
struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
struct buf { int x; };
FILE * (*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 don't provoke an error unfortunately, instead are silently treated
   as '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's necessary to write '\x00'==0 to get something
   that's 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 **, FILE *(*)(struct buf *, struct stat *, int), int, int);
int argc;
char **argv;
int
main ()
{
return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
  ;
  return 0;
}
_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
  test "x$ac_cv_prog_cc_c89" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC

fi
# AC_CACHE_VAL

case "x$ac_cv_prog_cc_c89" in
  x)
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
$as_echo "none needed" >&6; } ;;
  xno)
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
$as_echo "unsupported" >&6; } ;;
  *)
    CC="$CC $ac_cv_prog_cc_c89"

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
esac
if test "x$ac_cv_prog_cc_c89" != xno; then :










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


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5
$as_echo_n "checking for inline... " >&6; }
if ${ac_cv_c_inline+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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 () {return 0; }
$ac_kw foo_t foo () {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.$ac_ext
  test "$ac_cv_c_inline" != no && break
done

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5
$as_echo "$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;;







|
|

|
>

|



|
|

|
|

|
>





|



|
|

|
|





|
|


|
|

|
>





|



|
|













>
>
>
>
>
>
>
>
>









|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|








|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|







|
|












|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|








|
|
|
>
|
|








>
|
>
>
>

|
|




|















|






|
|

|
|










|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|












|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|











|
|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|
|




|


|






|









|







|











|
|
|




















|


|
|
>
















|















|


|
>
|
|
|


|
|


|
|
|

|
|
|
|




|
|






|


|
|
>













|
|
|




|
|








|











|
|







|


|







|


|






|
|
|





|
|



|
|
|
>
|
|




|













|


|
|
>








|
|


|
|





|
|


|
|
|
>
|
|




|









|
>

|


|



|
|
>
>





|

|
|
|
>
|
|








|






|
>

|





|






|
>

|






|






|
>


|

|

|


|
|
|














|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<





|
>


|







>
|
|
|
|
|
|
|
|
|
>
|
|

|
>
>
>
>
>
>
>
>
>










|
|
|
>
|
|






|
|



|
>


|




|
|







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
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
#	- 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
$as_echo_n "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 ${ac_cv_prog_CPP+:} false; then :

  $as_echo_n "(cached) " >&6
else
      # Double quotes because CPP needs to be expanded
    for CPP in "$CC -E" "$CC -E -traditional-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.
  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
  # <limits.h> exists even on freestanding compilers.
  # 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.  */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
		     Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :


else
  # 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
  # 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
$as_echo "$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.
  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
  # <limits.h> exists even on freestanding compilers.
  # 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.  */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
		     Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :


else
  # 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
  # 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_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
if ${ac_cv_path_GREP+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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
  $as_echo_n 0123456789 >"conftest.in"
  while :
  do
    cat "conftest.in" "conftest.in" >"conftest.tmp"
    mv "conftest.tmp" "conftest.in"
    cp "conftest.in" "conftest.nl"
    $as_echo '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







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|
|





|
>
|
|
|
|






<
<




<
|
<
<
<


|
>

|











|
>


|









|
>











|
|





<
<




<
|
<
<
<


|
>

|











|
>


|









|
>

|
|
|











|
|
|
>
|
|







>
|
>
>
>
|
>

|








|





|







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
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
    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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
$as_echo "$ac_cv_path_GREP" >&6; }
 GREP="$ac_cv_path_GREP"


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
$as_echo_n "checking for egrep... " >&6; }
if ${ac_cv_path_EGREP+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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
  $as_echo_n 0123456789 >"conftest.in"
  while :
  do
    cat "conftest.in" "conftest.in" >"conftest.tmp"
    mv "conftest.tmp" "conftest.in"
    cp "conftest.in" "conftest.nl"
    $as_echo '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







|
|



|
|
|
>
|
|










>
|
>
>
>
|
>

|








|





|







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
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
  fi
else
  ac_cv_path_EGREP=$EGREP
fi

   fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
$as_echo "$ac_cv_path_EGREP" >&6; }
 EGREP="$ac_cv_path_EGREP"


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
$as_echo_n "checking for ANSI C header files... " >&6; }
if ${ac_cv_header_stdc+:} false; then :
  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <float.h>

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  ac_cv_header_stdc=yes
else
  ac_cv_header_stdc=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

if test $ac_cv_header_stdc = yes; then
  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <string.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "memchr" >/dev/null 2>&1; then :

else
  ac_cv_header_stdc=no
fi
rm -f conftest*

fi

if test $ac_cv_header_stdc = yes; then
  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdlib.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "free" >/dev/null 2>&1; then :

else
  ac_cv_header_stdc=no
fi
rm -f conftest*

fi

if test $ac_cv_header_stdc = yes; then
  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
  if test "$cross_compiling" = yes; then :
  :
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <ctype.h>
#include <stdlib.h>
#if ((' ' & 0x0FF) == 0x020)
# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
#else
# define ISLOWER(c) \
		   (('a' <= (c) && (c) <= 'i') \
		     || ('j' <= (c) && (c) <= 'r') \
		     || ('s' <= (c) && (c) <= 'z'))
# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
#endif

#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
int
main ()
{
  int i;
  for (i = 0; i < 256; i++)
    if (XOR (islower (i), ISLOWER (i))
	|| toupper (i) != TOUPPER (i))
      return 2;
  return 0;
}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :

else
  ac_cv_header_stdc=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
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
$as_echo "$ac_cv_header_stdc" >&6; }
if test $ac_cv_header_stdc = yes; then

$as_echo "#define STDC_HEADERS 1" >>confdefs.h

fi

# On IRIX 5.3, sys/types and inttypes.h are conflicting.
for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
		  inttypes.h stdint.h unistd.h
do :
  as_ac_Header=`$as_echo "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 `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF

fi

done



    { $as_echo "$as_me:${as_lineno-$LINENO}: checking dirent.h" >&5
$as_echo_n "checking dirent.h... " >&6; }
if ${tcl_cv_dirent_h+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
#include <dirent.h>
int
main ()
{

#ifndef _POSIX_SOURCE
#   ifdef __Lynx__
	/*
	 * Generate compilation error to make the test fail:  Lynx headers
	 * are only valid if really in the POSIX environment.







|
|



<
<
<
<
<
<
<
<
<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
>
|
|






|







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
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
p = entryPtr->d_name;
closedir(d);

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_dirent_h=yes
else
  tcl_cv_dirent_h=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_dirent_h" >&5
$as_echo "$tcl_cv_dirent_h" >&6; }

    if test $tcl_cv_dirent_h = no; then

$as_echo "#define NO_DIRENT_H 1" >>confdefs.h

    fi

    ac_fn_c_check_header_mongrel "$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
  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
  tcl_ok=0
fi
rm -f 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
  tcl_ok=0
fi
rm -f conftest*

    if test $tcl_ok = 0; then

$as_echo "#define NO_STDLIB_H 1" >>confdefs.h

    fi
    ac_fn_c_check_header_mongrel "$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
  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
  tcl_ok=0
fi
rm -f 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
  tcl_ok=0
fi
rm -f conftest*


    # See also memmove check below for a place where NO_STRING_H can be
    # set and why.

    if test $tcl_ok = 0; then

$as_echo "#define NO_STRING_H 1" >>confdefs.h

    fi

    ac_fn_c_check_header_mongrel "$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_echo "#define NO_SYS_WAIT_H 1" >>confdefs.h

fi


    ac_fn_c_check_header_mongrel "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default"
if test "x$ac_cv_header_dlfcn_h" = xyes; then :


else

$as_echo "#define NO_DLFCN_H 1" >>confdefs.h

fi



    # OS/390 lacks sys/param.h (and doesn't need it, by chance).
    for ac_header in sys/param.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "sys/param.h" "ac_cv_header_sys_param_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_param_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_SYS_PARAM_H 1
_ACEOF

fi

done



#--------------------------------------------------------------------
# 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
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -pipe" >&5
$as_echo_n "checking if the compiler understands -pipe... " >&6; }
if ${tcl_cv_cc_pipe+:} false; then :

  $as_echo_n "(cached) " >&6
else

	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe"
	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_cc_pipe=yes
else
  tcl_cv_cc_pipe=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	CFLAGS=$hold_cflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_pipe" >&5
$as_echo "$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+set}" = set; then :

  withval=$with_encoding; with_tcencoding=${withval}
fi


    if test x"${with_tcencoding}" != x ; then

cat >>confdefs.h <<_ACEOF
#define TCL_CFGVAL_ENCODING "${with_tcencoding}"
_ACEOF

    else

$as_echo "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h

    fi


#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------































































































    #--------------------------------------------------------------------
    # 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
  MATH_LIBS="-lm"
fi


    #--------------------------------------------------------------------
    # Interactive UNIX requires -linet instead of -lsocket, plus it
    # needs net/errno.h to define the socket-related error codes.
    #--------------------------------------------------------------------

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -linet" >&5
$as_echo_n "checking for main in -linet... " >&6; }
if ${ac_cv_lib_inet_main+:} false; then :

  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-linet  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */


int
main ()
{
return main ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_inet_main=yes
else
  ac_cv_lib_inet_main=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_main" >&5
$as_echo "$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_mongrel "$LINENO" "net/errno.h" "ac_cv_header_net_errno_h" "$ac_includes_default"
if test "x$ac_cv_header_net_errno_h" = xyes; then :



$as_echo "#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:







|
>

|


|


|
|



|



|
|
>

|


<







|
>

|


|







|
>

|


|



|


|
|
>

|



>
>
>
>
>
>
>
>
>
>
>
>
>







<
<
<
<
<
<
<
<
<
<
<
<
<
|
>

|


|







|



|
|
>

|

|



<
|
|
>

|

|




<

<
<
|
|
<
>
|
<



<
<














|
|
|
>
|
|






|






|
>

|


|


|
|












|
>






<
|
<



|








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







|
>

|









|
|
|
>
|
|







|






|
>

|


|



|
|
|
>



|
|
>


|


<







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
4077

4078
4079
4080
4081
4082
4083
4084
4085

4086
4087
4088
4089
4090

4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113

4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124

4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137

4138
4139
4140
4141
4142
4143
4144
4145

4146
4147
4148
4149
4150

4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173

4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184

4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199

4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222

4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233

4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247

4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270

4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281

4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295

4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318

4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329

4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341

4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364

4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375

4376
4377
4378
4379
4380
4381
4382
4383
4384

4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407

4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418

4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439

4440
4441

4442

4443

4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457

4458
4459
4460
4461
4462
4463
4464
4465
4466

4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481

4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519

4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561

4562
4563
4564
4565

4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577

4578
4579
4580
4581

4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603

4604
4605
4606
4607
4608
4609
4610

4611
4612
4613
4614
4615

4616
4617
4618
4619

4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630

4631
4632
4633
4634
4635
4636
4637
4638
4639
4640

4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660

4661
4662
4663
4664
4665
4666

4667
4668
4669
4670

4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682

4683
4684
4685
4686

4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709

4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720

4721
4722
4723
4724
4725
4726
4727
4728
4729

4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757

4758
4759
4760
4761
4762
4763
4764
4765
4766

4767



4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797

4798
4799
4800
4801
4802
4803
4804
4805
4806

4807



4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851

4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865

4866
4867
4868
4869
4870
4871
4872
4873
4874

4875
4876
4877
4878
4879
4880
4881
4882
4883

4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901

4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912

4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928

4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943

4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976

4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999

5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010

5011
5012
5013
5014
5015
5016
5017
5018
5019
    #	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
  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_echo "$as_me:${as_lineno-$LINENO}: checking for setsockopt in -lsocket" >&5
$as_echo_n "checking for setsockopt in -lsocket... " >&6; }
if ${ac_cv_lib_socket_setsockopt+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char setsockopt ();
int
main ()
{
return setsockopt ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_socket_setsockopt=yes
else
  ac_cv_lib_socket_setsockopt=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_setsockopt" >&5
$as_echo "$ac_cv_lib_socket_setsockopt" >&6; }
if test "x$ac_cv_lib_socket_setsockopt" = xyes; then :

  LIBS="$LIBS -lsocket"
else
  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
  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_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5
$as_echo_n "checking for gethostbyname in -lnsl... " >&6; }
if ${ac_cv_lib_nsl_gethostbyname+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char gethostbyname ();
int
main ()
{
return gethostbyname ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_nsl_gethostbyname=yes
else
  ac_cv_lib_nsl_gethostbyname=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5
$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; }
if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then :

  LIBS="$LIBS -lnsl"
fi

fi



$as_echo "#define _REENTRANT 1" >>confdefs.h


$as_echo "#define _THREAD_SAFE 1" >>confdefs.h

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthread" >&5
$as_echo_n "checking for pthread_mutex_init in -lpthread... " >&6; }
if ${ac_cv_lib_pthread_pthread_mutex_init+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_pthread_pthread_mutex_init=yes
else
  ac_cv_lib_pthread_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_pthread_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes; then :

  tcl_ok=yes
else
  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]
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __pthread_mutex_init in -lpthread" >&5
$as_echo_n "checking for __pthread_mutex_init in -lpthread... " >&6; }
if ${ac_cv_lib_pthread___pthread_mutex_init+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char __pthread_mutex_init ();
int
main ()
{
return __pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_pthread___pthread_mutex_init=yes
else
  ac_cv_lib_pthread___pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_pthread___pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes; then :

  tcl_ok=yes
else
  tcl_ok=no
fi

    fi

    if test "$tcl_ok" = "yes"; then
	# The space is needed
	THREADS_LIBS=" -lpthread"
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthreads" >&5
$as_echo_n "checking for pthread_mutex_init in -lpthreads... " >&6; }
if ${ac_cv_lib_pthreads_pthread_mutex_init+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_pthreads_pthread_mutex_init=yes
else
  ac_cv_lib_pthreads_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes; then :

  _ok=yes
else
  tcl_ok=no
fi

	if test "$tcl_ok" = "yes"; then
	    # The space is needed
	    THREADS_LIBS=" -lpthreads"
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc" >&5
$as_echo_n "checking for pthread_mutex_init in -lc... " >&6; }
if ${ac_cv_lib_c_pthread_mutex_init+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_c_pthread_mutex_init=yes
else
  ac_cv_lib_c_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_c_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes; then :

  tcl_ok=yes
else
  tcl_ok=no
fi

	    if test "$tcl_ok" = "no"; then
		{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc_r" >&5
$as_echo_n "checking for pthread_mutex_init in -lc_r... " >&6; }
if ${ac_cv_lib_c_r_pthread_mutex_init+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
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
  ac_cv_lib_c_r_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5
$as_echo "$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
  tcl_ok=no
fi

		if test "$tcl_ok" = "yes"; then
		    # The space is needed
		    THREADS_LIBS=" -pthread"
		else
		    { $as_echo "$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
$as_echo "$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"

    for ac_func in pthread_attr_setstacksize pthread_atfork
do :

  as_ac_var=`$as_echo "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 `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF

fi
done

    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
  ac_have_decl=0
fi

cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE $ac_have_decl
_ACEOF
if test $ac_have_decl = 1; then :

  tcl_ok=yes
else
  tcl_ok=no
fi



# Add the threads support libraries
LIBS="$LIBS$THREADS_LIBS"


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
$as_echo_n "checking how to build libraries... " >&6; }
    # Check whether --enable-shared was given.
if test "${enable_shared+set}" = set; then :

  enableval=$enable_shared; tcl_ok=$enableval
else
  tcl_ok=yes
fi


    if test "${enable_shared+set}" = set; then
	enableval="$enable_shared"
	tcl_ok=$enableval
    else
	tcl_ok=yes
    fi

    if test "$tcl_ok" = "yes" ; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5
$as_echo "shared" >&6; }
	SHARED_BUILD=1
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
$as_echo "static" >&6; }
	SHARED_BUILD=0

$as_echo "#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.
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
$as_echo_n "checking for tclsh... " >&6; }
    if ${ac_cv_path_tclsh+:} false; then :

  $as_echo_n "(cached) " >&6
else

	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"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
$as_echo "$TCLSH_PROG" >&6; }
    else
	# It is not an error if an installed version of Tcl can't be located.
	TCLSH_PROG=""
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
$as_echo "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_mongrel "$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
  zlib_ok=no
fi

else

  zlib_ok=no
fi


if test $zlib_ok = yes; then :


  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing deflateSetHeader" >&5
$as_echo_n "checking for library containing deflateSetHeader... " >&6; }
if ${ac_cv_search_deflateSetHeader+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char deflateSetHeader ();
int
main ()
{
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$ac_exeext
  if ${ac_cv_search_deflateSetHeader+:} false; then :

  break
fi
done
if ${ac_cv_search_deflateSetHeader+:} false; then :


else
  ac_cv_search_deflateSetHeader=no
fi
rm conftest.$ac_ext
LIBS=$ac_func_search_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_deflateSetHeader" >&5
$as_echo "$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

    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

$as_echo "#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+set}" = set; 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_mongrel "$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
  libtommath_ok=no
fi

else

	libtommath_ok=no
fi


    if test $libtommath_ok = yes; then :


	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mp_log_u32 in -ltommath" >&5
$as_echo_n "checking for mp_log_u32 in -ltommath... " >&6; }
if ${ac_cv_lib_tommath_mp_log_u32+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char mp_log_u32 ();
int
main ()
{
return mp_log_u32 ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_tommath_mp_log_u32=yes
else
  ac_cv_lib_tommath_mp_log_u32=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tommath_mp_log_u32" >&5
$as_echo "$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

    libtommath_ok=no
fi

fi
fi
if test $libtommath_ok = yes; then :



$as_echo "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h


else

  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_RANLIB+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
$as_echo "$RANLIB" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
$as_echo "$ac_ct_RANLIB" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi

  if test "x$ac_ct_RANLIB" = x; then
    RANLIB=":"
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$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?

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5
$as_echo_n "checking if 64bit support is requested... " >&6; }
    # Check whether --enable-64bit was given.
if test "${enable_64bit+set}" = set; then :

  enableval=$enable_64bit; do64bit=$enableval
else
  do64bit=no
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5
$as_echo "$do64bit" >&6; }

    # Step 0.b: Enable Solaris 64 bit VIS support?

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit Sparc VIS support is requested" >&5
$as_echo_n "checking if 64bit Sparc VIS support is requested... " >&6; }
    # Check whether --enable-64bit-vis was given.
if test "${enable_64bit_vis+set}" = set; then :

  enableval=$enable_64bit_vis; do64bitVIS=$enableval
else
  do64bitVIS=no
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bitVIS" >&5
$as_echo "$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.

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler supports visibility \"hidden\"" >&5
$as_echo_n "checking if compiler supports visibility \"hidden\"... " >&6; }
if ${tcl_cv_cc_visibility_hidden+:} false; then :

  $as_echo_n "(cached) " >&6
else

	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 ()
{
f();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_cc_visibility_hidden=yes
else
  tcl_cv_cc_visibility_hidden=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
	CFLAGS=$hold_cflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_visibility_hidden" >&5
$as_echo "$tcl_cv_cc_visibility_hidden" >&6; }
    if test $tcl_cv_cc_visibility_hidden = yes; then :



$as_echo "#define MODULE_SCOPE extern __attribute__((__visibility__(\"hidden\")))" >>confdefs.h


$as_echo "#define HAVE_HIDDEN 1" >>confdefs.h


fi

    # Step 0.d: Disable -rpath support?

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if rpath support is requested" >&5
$as_echo_n "checking if rpath support is requested... " >&6; }
    # Check whether --enable-rpath was given.
if test "${enable_rpath+set}" = set; then :

  enableval=$enable_rpath; doRpath=$enableval
else
  doRpath=yes
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doRpath" >&5
$as_echo "$doRpath" >&6; }

    # Step 1: set the variable "system" to hold the name and version number
    # for the system.


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5
$as_echo_n "checking system version... " >&6; }
if ${tcl_cv_sys_version+:} false; then :

  $as_echo_n "(cached) " >&6
else

	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
		{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5
$as_echo "$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.

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5
$as_echo_n "checking for dlopen in -ldl... " >&6; }
if ${ac_cv_lib_dl_dlopen+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char dlopen ();
int
main ()
{
return dlopen ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_dl_dlopen=yes
else
  ac_cv_lib_dl_dlopen=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5
$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
if test "x$ac_cv_lib_dl_dlopen" = xyes; then :

  have_dl=yes
else
  have_dl=no
fi


    # Require ranlib early so we can override it in special cases below.









|
>

|





|
>

|
|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|










|
>

|





|
>

|
|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>







|


|

|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|









|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|









|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|







|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|




|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|







|
|










>
|
|
>
|
>
|
>
|
|
<
<


<






|
>

|



<
|
<
|
>

|









|
|

|
>

|



<
<
<
<
<
<
<
<

|
|


|
|


|












|
|
|
>
|
|



















|
|



|
|












|
|
>



|
>

|



|




<
|
>

|
|
|
>
|
|







<
<
<


|






|
>






|
>


|

|
>



|
>

|





|
|

|
>


|






|
>










|








|
>




|
|
>



|
>

|



|




<
|
>

|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|






|
>


|


|



















|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|








|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|







|
|












|
|

|
>

|



|
|



|
|

|
>

|



|
|

|
>






|
|
|
>
|
|








|






|
>

|


|



|
|
|
>


|


|






|
|

|
>

|



|
|





|
|
|
>
|
|






|
|












|
|






|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|







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
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
    # 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 -Wdeclaration-after-statement"
		;;
	esac


else

	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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_AR+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
$as_echo "$AR" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_AR+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
$as_echo "$ac_ct_AR" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi

  if test "x$ac_ct_AR" = x; then
    AR=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$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
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result: Using $CC for compiling with threads" >&5
$as_echo "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 :


		    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5
$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;}

else

		    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

		    CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}'

fi
		LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'

else

		if test "$GCC" = yes; then :


		    SHLIB_LD='${CC} -shared -Wl,-bexpall'

else

		    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"







|
>







|




|








|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|








|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|







|
|













|
>




|
>











|
|














|
>

|
>

|
|

|












|
>





|
>



|






|

|
>



|







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
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
	    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.
	    #-----------------------------------------------------------
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lbind" >&5
$as_echo_n "checking for inet_ntoa in -lbind... " >&6; }
if ${ac_cv_lib_bind_inet_ntoa+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char inet_ntoa ();
int
main ()
{
return inet_ntoa ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_bind_inet_ntoa=yes
else
  ac_cv_lib_bind_inet_ntoa=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bind_inet_ntoa" >&5
$as_echo "$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"







|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>







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
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
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*)
	    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]"
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Cygwin version of gcc" >&5
$as_echo_n "checking for Cygwin version of gcc... " >&6; }
if ${ac_cv_cygwin+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

		#ifdef __CYGWIN__
		    #error cygwin
		#endif

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  ac_cv_cygwin=no
else
  ac_cv_cygwin=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5
$as_echo "$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.







|












|
|
|
>
|
|








|






|
>

|


|


|
|







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
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
	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"
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lnetwork" >&5
$as_echo_n "checking for inet_ntoa in -lnetwork... " >&6; }
if ${ac_cv_lib_network_inet_ntoa+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char inet_ntoa ();
int
main ()
{
return inet_ntoa ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_network_inet_ntoa=yes
else
  ac_cv_lib_network_inet_ntoa=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_network_inet_ntoa" >&5
$as_echo "$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

$as_echo "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h


$as_echo "#define _XOPEN_SOURCE 1" >>confdefs.h

	    LIBS="$LIBS -lxnet"               # Use the XOPEN network library

	    if test "`uname -m`" = ia64; then :


		SHLIB_SUFFIX=".so"

else

		SHLIB_SUFFIX=".sl"

fi
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5
$as_echo_n "checking for shl_load in -ldld... " >&6; }
if ${ac_cv_lib_dld_shl_load+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char shl_load ();
int
main ()
{
return shl_load ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_dld_shl_load=yes
else
  ac_cv_lib_dld_shl_load=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5
$as_echo "$ac_cv_lib_dld_shl_load" >&6; }
if test "x$ac_cv_lib_dld_shl_load" = xyes; then :

  tcl_ok=yes
else
  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

		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}
			    ;;
			*)
			    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5
$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;}
			    ;;
		    esac

else

		    do64bit_ok=yes
		    CFLAGS="$CFLAGS +DD64"
		    LDFLAGS_ARCH="+DD64"

fi

fi ;;
	HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
	    SHLIB_SUFFIX=".sl"
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5
$as_echo_n "checking for shl_load in -ldld... " >&6; }
if ${ac_cv_lib_dld_shl_load+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char shl_load ();
int
main ()
{
return shl_load ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_dld_shl_load=yes
else
  ac_cv_lib_dld_shl_load=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5
$as_echo "$ac_cv_lib_dld_shl_load" >&6; }
if test "x$ac_cv_lib_dld_shl_load" = xyes; then :

  tcl_ok=yes
else
  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"







|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>







|


|



|
>



|




|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|



|
>











|
>




|









|
>

|
>






|
>






|
|



|










|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|



|
>







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
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
	    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

		case $system in
		    IRIX-6.3)
			# Use to build 6.2 compatible binaries on 6.3.
			CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS"
			;;
		    *)







|
>

















|
>




|
>




|







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
5670

5671
5672
5673
5674
5675
5676
5677
5678

5679
5680

5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
	    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 :


	            { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5
$as_echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;}

else

	            do64bit_ok=yes
	            SHLIB_LD="ld -64 -shared -rdata_shared"
	            CFLAGS="$CFLAGS -64"
	            LDFLAGS_ARCH="-64"

fi







|
>







|
>

|
>

|
|

|







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
5710

5711
5712
5713
5714
5715

5716
5717
5718

5719
5720
5721
5722

5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739

5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750

5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765

5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777

5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797

5798
5799
5800
5801
5802
5803
5804
	    # 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 :


		{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -m64 flag" >&5
$as_echo_n "checking if compiler accepts -m64 flag... " >&6; }
if ${tcl_cv_cc_m64+:} false; then :

  $as_echo_n "(cached) " >&6
else

		    hold_cflags=$CFLAGS
		    CFLAGS="$CFLAGS -m64"
		    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_cc_m64=yes
else
  tcl_cv_cc_m64=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
		    CFLAGS=$hold_cflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_m64" >&5
$as_echo "$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"







|
>




|
>


|
>

|
|
|
>
|
|







|






|
>

|


|



|
|
|
>














|
>











|
>



















|
>







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
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
	    # 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"







|
>
















|
>







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
5869

5870
5871
5872
5873
5874
5875

5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892

5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903

5904
5905
5906
5907
5908
5909
5910
5911
5912

5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929

5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940

5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955

5956
5957
5958
5959
5960
5961
5962
5963
5964

5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981

5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992

5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003

6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020

6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031

6032
6033
6034
6035
6036

6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055

6056
6057
6058
6059
6060
6061
6062
6063

6064
6065
6066
6067

6068
6069
6070
6071
6072

6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094

6095
6096
6097
6098
6099
6100
6101

6102
6103
6104
6105
6106
6107
6108
6109
6110
6111

6112
6113
6114
6115
6116
6117
6118
6119
6120
6121

6122
6123
6124
6125

6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143

6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156

6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
6177
6178
6179

6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191

6192
6193
6194
6195
6196

6197
6198
6199
6200
6201
6202
6203
6204
6205
6206

6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
	    # -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)
			{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch ppc64 flag" >&5
$as_echo_n "checking if compiler accepts -arch ppc64 flag... " >&6; }
if ${tcl_cv_cc_arch_ppc64+:} false; then :

  $as_echo_n "(cached) " >&6
else

			    hold_cflags=$CFLAGS
			    CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5"
			    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_cc_arch_ppc64=yes
else
  tcl_cv_cc_arch_ppc64=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
			    CFLAGS=$hold_cflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_ppc64" >&5
$as_echo "$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)
			{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch x86_64 flag" >&5
$as_echo_n "checking if compiler accepts -arch x86_64 flag... " >&6; }
if ${tcl_cv_cc_arch_x86_64+:} false; then :

  $as_echo_n "(cached) " >&6
else

			    hold_cflags=$CFLAGS
			    CFLAGS="$CFLAGS -arch x86_64"
			    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_cc_arch_x86_64=yes
else
  tcl_cv_cc_arch_x86_64=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
			    CFLAGS=$hold_cflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_x86_64" >&5
$as_echo "$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;;
		    *)
			{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5
$as_echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};;
		esac

else

		# 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}'
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -single_module flag" >&5
$as_echo_n "checking if ld accepts -single_module flag... " >&6; }
if ${tcl_cv_ld_single_module+:} false; then :

  $as_echo_n "(cached) " >&6
else

		hold_ldflags=$LDFLAGS
		LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module"
		cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{
int i;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_ld_single_module=yes
else
  tcl_cv_ld_single_module=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
		LDFLAGS=$hold_ldflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_single_module" >&5
$as_echo "$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"
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -search_paths_first flag" >&5
$as_echo_n "checking if ld accepts -search_paths_first flag... " >&6; }
if ${tcl_cv_ld_search_paths_first+:} false; then :

  $as_echo_n "(cached) " >&6
else

		hold_ldflags=$LDFLAGS
		LDFLAGS="$LDFLAGS -Wl,-search_paths_first"
		cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{
int i;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_ld_search_paths_first=yes
else
  tcl_cv_ld_search_paths_first=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
		LDFLAGS=$hold_ldflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_search_paths_first" >&5
$as_echo "$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 :



$as_echo "#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"

$as_echo "#define MAC_OSX_TCL 1" >>confdefs.h

	    PLAT_OBJS='${MAC_OSX_OBJS}'
	    PLAT_SRCS='${MAC_OSX_SRCS}'
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use CoreFoundation" >&5
$as_echo_n "checking whether to use CoreFoundation... " >&6; }
	    # Check whether --enable-corefoundation was given.
if test "${enable_corefoundation+set}" = set; then :

  enableval=$enable_corefoundation; tcl_corefoundation=$enableval
else
  tcl_corefoundation=yes
fi

	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_corefoundation" >&5
$as_echo "$tcl_corefoundation" >&6; }
	    if test $tcl_corefoundation = yes; then :


		{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for CoreFoundation.framework" >&5
$as_echo_n "checking for CoreFoundation.framework... " >&6; }
if ${tcl_cv_lib_corefoundation+:} false; then :

  $as_echo_n "(cached) " >&6
else

		    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 ()
{
CFBundleRef b = CFBundleGetMainBundle();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_lib_corefoundation=yes
else
  tcl_cv_lib_corefoundation=no
fi
rm -f core conftest.err conftest.$ac_objext \
    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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation" >&5
$as_echo "$tcl_cv_lib_corefoundation" >&6; }
		if test $tcl_cv_lib_corefoundation = yes; then :


		    LIBS="$LIBS -framework CoreFoundation"

$as_echo "#define HAVE_COREFOUNDATION 1" >>confdefs.h


else
  tcl_corefoundation=no
fi
		if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then :


		    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit CoreFoundation" >&5
$as_echo_n "checking for 64-bit CoreFoundation... " >&6; }
if ${tcl_cv_lib_corefoundation_64+:} false; then :

  $as_echo_n "(cached) " >&6
else

			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 ()
{
CFBundleRef b = CFBundleGetMainBundle();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_lib_corefoundation_64=yes
else
  tcl_cv_lib_corefoundation_64=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
			for v in CFLAGS CPPFLAGS LDFLAGS; do
			    eval $v'="$hold_'$v'"'
			done
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation_64" >&5
$as_echo "$tcl_cv_lib_corefoundation_64" >&6; }
		    if test $tcl_cv_lib_corefoundation_64 = no; then :



$as_echo "#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

$as_echo "#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

	        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

		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

		CFLAGS="$CFLAGS -pthread"
		LDFLAGS="$LDFLAGS -pthread"

fi
	    ;;
	QNX-6*)







|
>



|
|
|
>
|
|







|






|
>

|


|



|
|
|
>






|
|
|
>
|
|







|






|
>

|


|



|
|
|
>






|
|


|



|
>






|
|
|
>
|
|







|






|
>

|


|



|
|
|
>








|
|
|
>
|
|







|






|
>

|


|



|
|
|
>




|
>


|








|



|
|

|
>

|



|
|
|
>

|
|
|
>
|
|


|
>














|






|
>

|


|

|
>







|
|
|
>



|


|


|
>

|
|
|
>
|
|








|






|
>

|


|





|
|
|
>


|













|





|
>



|







|
>




|
>

|







|
>



|







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
6233

6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
6265
6266
6267
6268
6269

6270
6271
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286
6287
6288
6289
6290
6291
6292
6293
6294
6295
6296
6297

6298
6299
6300

6301
6302

6303
6304

6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315
6316
6317
6318
6319
6320
6321

6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338

6339
6340

6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378

6379
6380
6381
6382
6383
6384
6385

6386
6387
6388
6389
6390
6391

6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410

6411
6412
6413
6414
6415

6416
6417

6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428

6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439

6440
6441
6442
6443
6444
6445
6446
6447
6448
	    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

		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.


$as_echo "#define _REENTRANT 1" >>confdefs.h


$as_echo "#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

		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.


$as_echo "#define _REENTRANT 1" >>confdefs.h


$as_echo "#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 :


			    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5
$as_echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;}

else

			    do64bit_ok=yes
			    CFLAGS="$CFLAGS -m64 -mcpu=v9"
			    LDFLAGS="$LDFLAGS -m64 -mcpu=v9"
			    SHLIB_CFLAGS="-fPIC"

fi

else

			do64bit_ok=yes
			if test "$do64bitVIS" = yes; then :


			    CFLAGS="$CFLAGS -xarch=v9a"
			    LDFLAGS_ARCH="-xarch=v9a"

else

			    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
  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";;
			    *)
				{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5
$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};;
			esac

else

			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_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported for $arch" >&5
$as_echo "$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

		arch=`isainfo`
		{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use -lsunmath for fp rounding control" >&5
$as_echo_n "checking whether to use -lsunmath for fp rounding control... " >&6; }
		if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then :


			{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
			MATH_LIBS="-lsunmath $MATH_LIBS"
			ac_fn_c_check_header_mongrel "$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_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
  if test "$arch" = "amd64 i386"; then :


			SHLIB_LD="$SHLIB_LD -m64 -static-libgcc"

fi
fi

fi

else

		if test "$use_sunmath" = yes; then :

  textmode=textoff
else
  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";;







|
>




|




















|


|






|
>





|












|


|





|
>


|
>

|
>

|
>

|
|

|








|


|
>




|










|
|
>

|
>







|
|


|













|
|
|









|
>

|


|
|
|
>

|
|

|
|
>


<



|

|
|








|
>




|
>

|
>









|
|
>








|

|
>

|







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
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
	    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.
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld accepts -Bexport flag" >&5
$as_echo_n "checking for ld accepts -Bexport flag... " >&6; }
if ${tcl_cv_ld_Bexport+:} false; then :

  $as_echo_n "(cached) " >&6
else

		hold_ldflags=$LDFLAGS
		LDFLAGS="$LDFLAGS -Wl,-Bexport"
		cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{
int i;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_ld_Bexport=yes
else
  tcl_cv_ld_Bexport=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
	        LDFLAGS=$hold_ldflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5
$as_echo "$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 :


	{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5
$as_echo "$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 :



$as_echo "#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+set}" = set; then :

  enableval=$enable_load; tcl_ok=$enableval
else
  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_echo "$as_me:${as_lineno-$LINENO}: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5
$as_echo "$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_*) ;;
	    HP_UX*) ;;
	    Darwin-*) ;;
	    IRIX*) ;;
	    Linux*|GNU*) ;;
	    NetBSD-*|OpenBSD-*) ;;
	    OSF1-V*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac
fi

    if test "$tcl_cv_cc_visibility_hidden" != yes; then :



$as_echo "#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

            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'

fi

else

        LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}

        if test "$RANLIB" = ""; then :


            MAKE_LIB='$(STLIB_LD) $@ ${OBJS}'

else

            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

        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.

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5
$as_echo_n "checking for cast to union support... " >&6; }
if ${tcl_cv_cast_to_union+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

		  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
  tcl_cv_cast_to_union=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5
$as_echo "$tcl_cv_cast_to_union" >&6; }
	if test "$tcl_cv_cast_to_union" = "yes"; then

$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h





























































	fi









    ac_fn_c_check_header_mongrel "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default"
if test "x$ac_cv_header_stdbool_h" = xyes; then :


$as_echo "#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.









|
|
|
>
|
|







|






|
>

|


|



|
|
|
>









|
>

|
|



|
>


|









|
>

|



|
>



|
>

|

|
|

















|
>




|




|






|
>


|




|
>



|
>





|
>



|
>




|





|



|
>



|









|
>



|









|
>





|
|
|

|
|
|
>
|
|




|


|
|





|
>

|


|


|
|
|

|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>

|
|
>

|


<







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
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738

6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6802
6803
6804
6805
6806

6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820

6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835

6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853

6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864
6865
6866
6867

6868
6869
6870
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
6881
6882

6883
6884
6885
6886
6887
6888
6889
6890
6891
6892
6893
6894
6895
6896
6897
6898
6899
6900

6901
6902
6903
6904
6905
6906
6907
6908
6909
6910
6911
6912
6913
6914

6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
6929

6930
6931
6932
6933
6934
6935
6936
6937
6938
6939
6940
6941
6942
6943
6944
6945
6946
6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958

6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6995
6996
6997

6998
6999
7000
7001
7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012
7013
7014
7015
7016
7017
7018
7019
7020
7021

7022
7023
7024
7025
7026
7027
7028
7029
7030
7031
7032
7033
7034
7035
7036
7037

7038
7039
7040
7041
7042
7043
7044
7045
7046
7047
7048
7049
7050
7051
7052
7053
7054

7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
7071

7072
7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088

7089
7090
7091
7092
7093
7094
7095
7096
7097
7098
7099
7100
7101
7102
7103
7104

7105
7106
7107
7108
7109
7110
7111
7112
7113
7114
7115
7116
7117
7118

7119
7120

7121

7122

7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133

7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149

7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
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







cat >>confdefs.h <<_ACEOF
#define TCL_SHLIB_EXT "${SHLIB_SUFFIX}"
_ACEOF











    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5
$as_echo_n "checking for build with symbols... " >&6; }
    # Check whether --enable-symbols was given.
if test "${enable_symbols+set}" = set; then :

  enableval=$enable_symbols; tcl_ok=$enableval
else
  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)'

$as_echo "#define NDEBUG 1" >>confdefs.h

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }

$as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h

    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	if test "$tcl_ok" = "yes"; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5
$as_echo "yes (standard debugging)" >&6; }
	fi
    fi



    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then

$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h

    fi

    	if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then

$as_echo "#define TCL_COMPILE_DEBUG 1" >>confdefs.h


$as_echo "#define TCL_COMPILE_STATS 1" >>confdefs.h

	fi

    if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
	if test "$tcl_ok" = "all"; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5
$as_echo "enabled symbols mem compile debugging" >&6; }
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5
$as_echo "enabled $tcl_ok debugging" >&6; }
	fi
    fi



$as_echo "#define MP_PREC 4" >>confdefs.h


#--------------------------------------------------------------------
#	Detect what compiler flags to set for 64-bit support.
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for required early compiler flags" >&5
$as_echo_n "checking for required early compiler flags... " >&6; }
    tcl_flags=""

    if ${tcl_cv_flag__isoc99_source+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdlib.h>
int
main ()
{
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
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#define _ISOC99_SOURCE 1
#include <stdlib.h>
int
main ()
{
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
  tcl_cv_flag__isoc99_source=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi

    if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then

$as_echo "#define _ISOC99_SOURCE 1" >>confdefs.h

	tcl_flags="$tcl_flags _ISOC99_SOURCE"
    fi


    if ${tcl_cv_flag__largefile64_source+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/stat.h>
int
main ()
{
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
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#define _LARGEFILE64_SOURCE 1
#include <sys/stat.h>
int
main ()
{
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
  tcl_cv_flag__largefile64_source=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi

    if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then

$as_echo "#define _LARGEFILE64_SOURCE 1" >>confdefs.h

	tcl_flags="$tcl_flags _LARGEFILE64_SOURCE"
    fi


    if ${tcl_cv_flag__largefile_source64+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/stat.h>
int
main ()
{
char *p = (char *)open64;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_flag__largefile_source64=no
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#define _LARGEFILE_SOURCE64 1
#include <sys/stat.h>
int
main ()
{
char *p = (char *)open64;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_flag__largefile_source64=yes
else
  tcl_cv_flag__largefile_source64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi

    if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then

$as_echo "#define _LARGEFILE_SOURCE64 1" >>confdefs.h

	tcl_flags="$tcl_flags _LARGEFILE_SOURCE64"
    fi

    if test "x${tcl_flags}" = "x" ; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
$as_echo "none" >&6; }
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5
$as_echo "${tcl_flags}" >&6; }
    fi



    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit integer type" >&5
$as_echo_n "checking for 64-bit integer type... " >&6; }
    if ${tcl_cv_type_64bit+:} false; then :

  $as_echo_n "(cached) " >&6
else

	tcl_cv_type_64bit=none
	# See if the compiler knows natively about __int64
	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{
__int64 value = (__int64) 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_type_64bit=__int64
else
  tcl_type_64bit="long long"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	# 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 ()
{
switch (0) {
            case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ;
        }
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_type_64bit=${tcl_type_64bit}
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi

    if test "${tcl_cv_type_64bit}" = none ; then

$as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
    else

cat >>confdefs.h <<_ACEOF
#define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit}
_ACEOF

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_cv_type_64bit}" >&5
$as_echo "${tcl_cv_type_64bit}" >&6; }

	# Now check for auxiliary declarations
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5
$as_echo_n "checking for struct dirent64... " >&6; }
if ${tcl_cv_struct_dirent64+:} false; then :

  $as_echo_n "(cached) " >&6
else

	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
#include <dirent.h>
int
main ()
{
struct dirent64 p;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_struct_dirent64=yes
else
  tcl_cv_struct_dirent64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5
$as_echo "$tcl_cv_struct_dirent64" >&6; }
	if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then

$as_echo "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h

	fi

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for DIR64" >&5
$as_echo_n "checking for DIR64... " >&6; }
if ${tcl_cv_DIR64+:} false; then :

  $as_echo_n "(cached) " >&6
else

	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
#include <dirent.h>
int
main ()
{
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
  tcl_cv_DIR64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_DIR64" >&5
$as_echo "$tcl_cv_DIR64" >&6; }
	if test "x${tcl_cv_DIR64}" = "xyes" ; then

$as_echo "#define HAVE_DIR64 1" >>confdefs.h

	fi

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5
$as_echo_n "checking for struct stat64... " >&6; }
if ${tcl_cv_struct_stat64+:} false; then :

  $as_echo_n "(cached) " >&6
else

	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/stat.h>
int
main ()
{
struct stat64 p;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_struct_stat64=yes
else
  tcl_cv_struct_stat64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_stat64" >&5
$as_echo "$tcl_cv_struct_stat64" >&6; }
	if test "x${tcl_cv_struct_stat64}" = "xyes" ; then

$as_echo "#define HAVE_STRUCT_STAT64 1" >>confdefs.h

	fi


	for ac_func in open64 lseek64
do :

  as_ac_var=`$as_echo "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 `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF

fi
done

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for off64_t" >&5
$as_echo_n "checking for off64_t... " >&6; }
	if ${tcl_cv_type_off64_t+:} false; then :

  $as_echo_n "(cached) " >&6
else

	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
int
main ()
{
off64_t offset;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_type_off64_t=yes
else
  tcl_cv_type_off64_t=no
fi
rm -f core conftest.err conftest.$ac_objext 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

$as_echo "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h

	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
	fi
    fi


#--------------------------------------------------------------------
#	Check endianness because we can optimize comparisons of
#	Tcl_UniChar strings to memcmp on big-endian systems.
#--------------------------------------------------------------------

 { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
if ${ac_cv_c_bigendian+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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







|
|
<











|
|

|
>

|








|

|
|

|





|
|







|





|


|





|
|

|
|





|







|
|


|
>
|
|




|






|
>

|





|






|
>

|


|

|




|





|
>
|
|




|






|
>

|





|






|
>

|


|

|




|





|
>
|
|




|






|
>

|





|






|
>

|


|

|




|





|
|

|
|




|
|
|
>
|
|


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







|


|





|
>
|

|




|

|
|

<
<
<
<
<
<
<
<

|
|
|
>
|
|






|






|
>

|


|

|
|


|



|
|
|
>
|
|






|







|
>

|


|

|
|


|



|
|
|
>
|
|





|







|
>

|


|

|
|


|



>
|
|
>
|
>
|
>
|
|
<
<


<

|
|
|
>
|
|





|







|
>

|


|






|

|
|

|
|









|
|
|
>
|
|










|
>







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
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
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
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
7919
7920
7921
7922
7923
7924
7925
7926
7927
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
	   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.$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 ()
{
#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 ()
{
#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
  ac_cv_c_bigendian=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext 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 ()
{
#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 ()
{
#ifndef _BIG_ENDIAN
		 not big endian
		#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  ac_cv_c_bigendian=yes
else
  ac_cv_c_bigendian=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext 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.  */
short int ascii_mm[] =
		  { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
		short int ascii_ii[] =
		  { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
		int use_ascii (int i) {
		  return ascii_mm[i] + ascii_ii[i];
		}
		short int ebcdic_ii[] =
		  { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
		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 ()
{
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.$ac_ext
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{

	     /* 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
  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
$as_echo "$ac_cv_c_bigendian" >&6; }
 case $ac_cv_c_bigendian in #(
   yes)
     $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h
;; #(
   no)
      ;; #(
   universal)

$as_echo "#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 :
  cat >>confdefs.h <<_ACEOF

#define HAVE_GETCWD 1
_ACEOF

else

$as_echo "#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 :

  $as_echo "#define HAVE_MKSTEMP 1" >>confdefs.h

else
  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 :

  $as_echo "#define HAVE_OPENDIR 1" >>confdefs.h

else
  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 :

  $as_echo "#define HAVE_STRTOL 1" >>confdefs.h

else
  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 :

  $as_echo "#define HAVE_WAITPID 1" >>confdefs.h

else
  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_echo "#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_echo "#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_echo "#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_echo "#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_echo "#define NO_REALPATH 1" >>confdefs.h

fi



	NEED_FAKE_RFC2553=0

	for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror
do :
  as_ac_var=`$as_echo "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 `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF

else
  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 :


cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_ADDRINFO 1
_ACEOF


else
  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 :


cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_IN6_ADDR 1
_ACEOF


else
  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 :


cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_SOCKADDR_IN6 1
_ACEOF


else
  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 :


cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_SOCKADDR_STORAGE 1
_ACEOF


else
  NEED_FAKE_RFC2553=1
fi

if test "x$NEED_FAKE_RFC2553" = "x1"; then

$as_echo "#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 :


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 5 args" >&5
$as_echo_n "checking for getpwuid_r with 5 args... " >&6; }
if ${tcl_cv_api_getpwuid_r_5+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	#include <sys/types.h>
	#include <pwd.h>

int
main ()
{

	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
  tcl_cv_api_getpwuid_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_5" >&5
$as_echo "$tcl_cv_api_getpwuid_r_5" >&6; }
    tcl_ok=$tcl_cv_api_getpwuid_r_5
    if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETPWUID_R_5 1" >>confdefs.h

    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 4 args" >&5
$as_echo_n "checking for getpwuid_r with 4 args... " >&6; }
if ${tcl_cv_api_getpwuid_r_4+:} false; then :

  $as_echo_n "(cached) " >&6
else

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #include <sys/types.h>
	    #include <pwd.h>

int
main ()
{

	    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
  tcl_cv_api_getpwuid_r_4=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_4" >&5
$as_echo "$tcl_cv_api_getpwuid_r_4" >&6; }
	tcl_ok=$tcl_cv_api_getpwuid_r_4
	if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETPWUID_R_4 1" >>confdefs.h

	fi
    fi
    if test "$tcl_ok" = yes; then

$as_echo "#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 :


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 5 args" >&5
$as_echo_n "checking for getpwnam_r with 5 args... " >&6; }
if ${tcl_cv_api_getpwnam_r_5+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	#include <sys/types.h>
	#include <pwd.h>

int
main ()
{

	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
  tcl_cv_api_getpwnam_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_5" >&5
$as_echo "$tcl_cv_api_getpwnam_r_5" >&6; }
    tcl_ok=$tcl_cv_api_getpwnam_r_5
    if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETPWNAM_R_5 1" >>confdefs.h

    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 4 args" >&5
$as_echo_n "checking for getpwnam_r with 4 args... " >&6; }
if ${tcl_cv_api_getpwnam_r_4+:} false; then :

  $as_echo_n "(cached) " >&6
else

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #include <sys/types.h>
	    #include <pwd.h>

int
main ()
{

	    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
  tcl_cv_api_getpwnam_r_4=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_4" >&5
$as_echo "$tcl_cv_api_getpwnam_r_4" >&6; }
	tcl_ok=$tcl_cv_api_getpwnam_r_4
	if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETPWNAM_R_4 1" >>confdefs.h

	fi
    fi
    if test "$tcl_ok" = yes; then

$as_echo "#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 :


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 5 args" >&5
$as_echo_n "checking for getgrgid_r with 5 args... " >&6; }
if ${tcl_cv_api_getgrgid_r_5+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	#include <sys/types.h>
	#include <grp.h>

int
main ()
{

	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
  tcl_cv_api_getgrgid_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_5" >&5
$as_echo "$tcl_cv_api_getgrgid_r_5" >&6; }
    tcl_ok=$tcl_cv_api_getgrgid_r_5
    if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETGRGID_R_5 1" >>confdefs.h

    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 4 args" >&5
$as_echo_n "checking for getgrgid_r with 4 args... " >&6; }
if ${tcl_cv_api_getgrgid_r_4+:} false; then :

  $as_echo_n "(cached) " >&6
else

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #include <sys/types.h>
	    #include <grp.h>

int
main ()
{

	    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
  tcl_cv_api_getgrgid_r_4=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_4" >&5
$as_echo "$tcl_cv_api_getgrgid_r_4" >&6; }
	tcl_ok=$tcl_cv_api_getgrgid_r_4
	if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETGRGID_R_4 1" >>confdefs.h

	fi
    fi
    if test "$tcl_ok" = yes; then

$as_echo "#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 :


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 5 args" >&5
$as_echo_n "checking for getgrnam_r with 5 args... " >&6; }
if ${tcl_cv_api_getgrnam_r_5+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	#include <sys/types.h>
	#include <grp.h>

int
main ()
{

	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
  tcl_cv_api_getgrnam_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_5" >&5
$as_echo "$tcl_cv_api_getgrnam_r_5" >&6; }
    tcl_ok=$tcl_cv_api_getgrnam_r_5
    if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETGRNAM_R_5 1" >>confdefs.h

    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 4 args" >&5
$as_echo_n "checking for getgrnam_r with 4 args... " >&6; }
if ${tcl_cv_api_getgrnam_r_4+:} false; then :

  $as_echo_n "(cached) " >&6
else

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #include <sys/types.h>
	    #include <grp.h>

int
main ()
{

	    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
  tcl_cv_api_getgrnam_r_4=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_4" >&5
$as_echo "$tcl_cv_api_getgrnam_r_4" >&6; }
	tcl_ok=$tcl_cv_api_getgrnam_r_4
	if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETGRNAM_R_4 1" >>confdefs.h

	fi
    fi
    if test "$tcl_ok" = yes; then

$as_echo "#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.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#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.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#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
  ac_have_decl=0
fi

cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_GETHOSTBYNAME_R $ac_have_decl
_ACEOF
if test $ac_have_decl = 1; then :


    tcl_cv_api_gethostbyname_r=yes
else
  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 :


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 6 args" >&5
$as_echo_n "checking for gethostbyname_r with 6 args... " >&6; }
if ${tcl_cv_api_gethostbyname_r_6+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	#include <netdb.h>

int
main ()
{

	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
  tcl_cv_api_gethostbyname_r_6=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_6" >&5
$as_echo "$tcl_cv_api_gethostbyname_r_6" >&6; }
    tcl_ok=$tcl_cv_api_gethostbyname_r_6
    if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETHOSTBYNAME_R_6 1" >>confdefs.h

    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 5 args" >&5
$as_echo_n "checking for gethostbyname_r with 5 args... " >&6; }
if ${tcl_cv_api_gethostbyname_r_5+:} false; then :

  $as_echo_n "(cached) " >&6
else

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #include <netdb.h>

int
main ()
{

	    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
  tcl_cv_api_gethostbyname_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_5" >&5
$as_echo "$tcl_cv_api_gethostbyname_r_5" >&6; }
	tcl_ok=$tcl_cv_api_gethostbyname_r_5
	if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETHOSTBYNAME_R_5 1" >>confdefs.h

	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 3 args" >&5
$as_echo_n "checking for gethostbyname_r with 3 args... " >&6; }
if ${tcl_cv_api_gethostbyname_r_3+:} false; then :

  $as_echo_n "(cached) " >&6
else

	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

		#include <netdb.h>

int
main ()
{

		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
  tcl_cv_api_gethostbyname_r_3=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_3" >&5
$as_echo "$tcl_cv_api_gethostbyname_r_3" >&6; }
	    tcl_ok=$tcl_cv_api_gethostbyname_r_3
	    if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETHOSTBYNAME_R_3 1" >>confdefs.h

	    fi
	fi
    fi
    if test "$tcl_ok" = yes; then

$as_echo "#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
  ac_have_decl=0
fi

cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_GETHOSTBYADDR_R $ac_have_decl
_ACEOF
if test $ac_have_decl = 1; then :


    tcl_cv_api_gethostbyaddr_r=yes
else
  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 :


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 7 args" >&5
$as_echo_n "checking for gethostbyaddr_r with 7 args... " >&6; }
if ${tcl_cv_api_gethostbyaddr_r_7+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	#include <netdb.h>

int
main ()
{

	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
  tcl_cv_api_gethostbyaddr_r_7=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_7" >&5
$as_echo "$tcl_cv_api_gethostbyaddr_r_7" >&6; }
    tcl_ok=$tcl_cv_api_gethostbyaddr_r_7
    if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETHOSTBYADDR_R_7 1" >>confdefs.h

    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 8 args" >&5
$as_echo_n "checking for gethostbyaddr_r with 8 args... " >&6; }
if ${tcl_cv_api_gethostbyaddr_r_8+:} false; then :

  $as_echo_n "(cached) " >&6
else

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #include <netdb.h>

int
main ()
{

	    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
  tcl_cv_api_gethostbyaddr_r_8=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_8" >&5
$as_echo "$tcl_cv_api_gethostbyaddr_r_8" >&6; }
	tcl_ok=$tcl_cv_api_gethostbyaddr_r_8
	if test "$tcl_ok" = yes; then

$as_echo "#define HAVE_GETHOSTBYADDR_R_8 1" >>confdefs.h

	fi
    fi
    if test "$tcl_ok" = yes; then

$as_echo "#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.
#---------------------------------------------------------------------------

for ac_header in termios.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "termios.h" "ac_cv_header_termios_h" "$ac_includes_default"
if test "x$ac_cv_header_termios_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_TERMIOS_H 1
_ACEOF

fi

done

for ac_header in sys/ioctl.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_ioctl_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_SYS_IOCTL_H 1
_ACEOF

fi

done

for ac_header in sys/modem.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "sys/modem.h" "ac_cv_header_sys_modem_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_modem_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_SYS_MODEM_H 1
_ACEOF

fi

done


#--------------------------------------------------------------------
#	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.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fd_set in sys/types" >&5
$as_echo_n "checking for fd_set in sys/types... " >&6; }
if ${tcl_cv_type_fd_set+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
int
main ()
{
fd_set readMask, writeMask;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_type_fd_set=yes
else
  tcl_cv_type_fd_set=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_fd_set" >&5
$as_echo "$tcl_cv_type_fd_set" >&6; }
tcl_ok=$tcl_cv_type_fd_set
if test $tcl_ok = no; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fd_mask in sys/select" >&5
$as_echo_n "checking for fd_mask in sys/select... " >&6; }
if ${tcl_cv_grep_fd_mask+:} false; then :

  $as_echo_n "(cached) " >&6
else

	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
  tcl_cv_grep_fd_mask=missing
fi
rm -f conftest*

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_fd_mask" >&5
$as_echo "$tcl_cv_grep_fd_mask" >&6; }
    if test $tcl_cv_grep_fd_mask = present; then

$as_echo "#define HAVE_SYS_SELECT_H 1" >>confdefs.h

	tcl_ok=yes
    fi
fi
if test $tcl_ok = no; then

$as_echo "#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
#------------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for advanced notifier support" >&5
$as_echo_n "checking for advanced notifier support... " >&6; }
case x`uname -s` in
  xLinux)
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: epoll(7)" >&5
$as_echo "epoll(7)" >&6; }
	for ac_header in sys/epoll.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "sys/epoll.h" "ac_cv_header_sys_epoll_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_epoll_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF
#define HAVE_SYS_EPOLL_H 1
_ACEOF

$as_echo "#define NOTIFIER_EPOLL 1" >>confdefs.h

fi

done

	for ac_header in sys/eventfd.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "sys/eventfd.h" "ac_cv_header_sys_eventfd_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_eventfd_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_SYS_EVENTFD_H 1
_ACEOF

$as_echo "#define HAVE_EVENTFD 1" >>confdefs.h

fi

done
;;
  xDragonFlyBSD|xFreeBSD|xNetBSD|xOpenBSD)
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: kqueue(2)" >&5
$as_echo "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=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :

  cat >>confdefs.h <<_ACEOF
#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF
 tcl_kqueue_headers=${tcl_kqueue_headers}y
fi

done

	if test $tcl_kqueue_headers = xyyy; then :



$as_echo "#define NOTIFIER_KQUEUE 1" >>confdefs.h

fi;;
  xDarwin)
	# Assume that we've got CoreFoundation present (checked elsewhere because
	# of wider impact).
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: OSX" >&5
$as_echo "OSX" >&6; };;
  *)
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
$as_echo "none" >&6; };;
esac

#------------------------------------------------------------------------------
#       Find out all about time handling differences.
#------------------------------------------------------------------------------


    for ac_header in sys/time.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "sys/time.h" "ac_cv_header_sys_time_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_time_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_SYS_TIME_H 1
_ACEOF

fi

done

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5
$as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; }

if ${ac_cv_header_time+:} false; then :
  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
#include <sys/time.h>
#include <time.h>

int



main ()

{


if ((struct tm *) 0)
return 0;

  ;

  return 0;
}

_ACEOF

if ac_fn_c_try_compile "$LINENO"; then :
  ac_cv_header_time=yes

else
  ac_cv_header_time=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_time" >&5
$as_echo "$ac_cv_header_time" >&6; }
if test $ac_cv_header_time = yes; then

$as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h

fi



    for ac_func in gmtime_r localtime_r mktime
do :
  as_ac_var=`$as_echo "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 `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF





fi





done




    { $as_echo "$as_me:${as_lineno-$LINENO}: checking tm_tzadj in struct tm" >&5
$as_echo_n "checking tm_tzadj in struct tm... " >&6; }
if ${tcl_cv_member_tm_tzadj+:} false; then :

  $as_echo_n "(cached) " >&6
else

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <time.h>
int
main ()
{
struct tm tm; tm.tm_tzadj;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_cv_member_tm_tzadj=yes
else
  tcl_cv_member_tm_tzadj=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_tzadj" >&5
$as_echo "$tcl_cv_member_tm_tzadj" >&6; }
    if test $tcl_cv_member_tm_tzadj = yes ; then

$as_echo "#define HAVE_TM_TZADJ 1" >>confdefs.h

    fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking tm_gmtoff in struct tm" >&5
$as_echo_n "checking tm_gmtoff in struct tm... " >&6; }
if ${tcl_cv_member_tm_gmtoff+:} false; then :
  $as_echo_n "(cached) " >&6
else

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <time.h>
int
main ()
{
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
  tcl_cv_member_tm_gmtoff=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_gmtoff" >&5
$as_echo "$tcl_cv_member_tm_gmtoff" >&6; }
    if test $tcl_cv_member_tm_gmtoff = yes ; then

$as_echo "#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.
    #
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking long timezone variable" >&5
$as_echo_n "checking long timezone variable... " >&6; }
if ${tcl_cv_timezone_long+:} false; then :

  $as_echo_n "(cached) " >&6
else

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <time.h>
int
main ()
{
extern long timezone;
	    timezone += 1;
	    exit (0);
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_timezone_long=yes
else
  tcl_cv_timezone_long=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_long" >&5
$as_echo "$tcl_cv_timezone_long" >&6; }
    if test $tcl_cv_timezone_long = yes ; then

$as_echo "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h

    else
	#
	# On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
	#
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking time_t timezone variable" >&5
$as_echo_n "checking time_t timezone variable... " >&6; }
if ${tcl_cv_timezone_time+:} false; then :

  $as_echo_n "(cached) " >&6
else

	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <time.h>
int
main ()
{
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
  tcl_cv_timezone_time=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_time" >&5
$as_echo "$tcl_cv_timezone_time" >&6; }
	if test $tcl_cv_timezone_time = yes ; then

$as_echo "#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 :


cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_STAT_ST_BLOCKS 1
_ACEOF


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 :


cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_STAT_ST_BLKSIZE 1
_ACEOF


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 :


cat >>confdefs.h <<_ACEOF
#define HAVE_BLKCNT_T 1
_ACEOF


fi

ac_fn_c_check_func "$LINENO" "fstatfs" "ac_cv_func_fstatfs"
if test "x$ac_cv_func_fstatfs" = xyes; then :


else

$as_echo "#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
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working memcmp" >&5
$as_echo_n "checking for working memcmp... " >&6; }
if ${ac_cv_func_memcmp_working+:} false; then :

  $as_echo_n "(cached) " >&6
else
  if test "$cross_compiling" = yes; then :

  ac_cv_func_memcmp_working=no
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{

  /* 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;








|








|











|
>







|









|
>

|


|

|








|









|
>






|









|
>

|


|

|



|
>



|

|




|

|







|






|
>












|
|




|















|
>

|








|
|


|





|














>
|


|
<
>
|
<

|

|


<

>




|
>
|

|







<

|
>
|

|







<

|
>
|

|







<

|
>
|

|








<

|
>

|

|




|
>

|

|




|
>

|

|




|
>

|

|











|
>

|

|






>
|

|

|
>

|


|


<

>







|
>

<
|
<


|









|
>

<
|
<


|









|
>

<
|
<


|









|
>

<
|
<


|





|








|
>











|
>

|
|
|
>
|
|








|













|
>

|


|

|
|



|


|
|
|
>
|
|








|













|
>

|


|

|
|



|





|






|
>

|
|
|
>
|
|








|













|
>

|


|

|
|



|


|
|
|
>
|
|








|













|
>

|


|

|
|



|





|






|
>

|
|
|
>
|
|








|













|
>

|


|

|
|



|


|
|
|
>
|
|








|













|
>

|


|

|
|



|





|






|
>

|
|
|
>
|
|








|













|
>

|


|

|
|



|


|
|
|
>
|
|








|













|
>

|


|

|
|



|





|











|


|








|


|







|
>

|



<
|
<
|
>


|







|
>

|
|
|
>
|
|







|














|
>

|


|

|
|



|


|
|
|
>
|
|







|














|
>

|


|

|
|



|


|
|
|
>
|
|







|












|
>

|


|

|
|



|






|











|
>

|



<
|
<
|
>


|







|
>

|
|
|
>
|
|







|

















|
>

|


|

|
|



|


|
|
|
>
|
|







|

















|
>

|


|

|
|



|





|


















<
<
|
|
<
>
|
<



<
<
<
<
|
|
<
>
|
<



<
<
<
<
|
|
<
>
|
<


<
<












|
|
|
>
|
|





|






|
>

|


|

|
|


|
|
|
>
|
|







|
>

|


|


|
|


|






|








|
|


|
|
|

|
|
|
|
<

|




<
|

|
|
<
>
|
<

|



|
<

|
|



|

|
|
|
>

|





<
|
>


|





|
|

|
|







|
<
|
|
<
>
|
<



|

<
<
>
|
<
|
<
|
<
<
<

<
>
>
>
|
>
|
>
>
|
|
>
|
>
|
|
>
|
>
|
<
>
|
|
|
|
>
|
<
|
<
|
<
|
<
|
>
|
<
<
<
<
<
<
<

|
>
>
>
>

>
>
>
>
>
|
>

>

|
|
|
>
|
|





|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






|
>

|


|

|
|


|







|
|
|
>
|
|





|








|
>

|


|

|
|


|





|
|
|
>
|
|





|








|
>

|


|

|
|


|













|
>

<
|
<




|
>

<
|
<






|
>

<
|
<





|
>

|

|









|
|
|
>
|
|
|
>

|




|







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
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
    return 0;
  }

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :

  ac_cv_func_memcmp_working=yes
else
  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_memcmp_working" >&5
$as_echo "$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_echo "#define NO_MEMMOVE 1" >>confdefs.h


$as_echo "#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
  tcl_ok=0
fi

    if test "$tcl_ok" = 1; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strstr implementation" >&5
$as_echo_n "checking proper strstr implementation... " >&6; }
if ${tcl_cv_strstr_unbroken+:} false; then :

  $as_echo_n "(cached) " >&6
else
  if test "$cross_compiling" = yes; then :

  tcl_cv_strstr_unbroken=unknown
else
  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
  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strstr_unbroken" >&5
$as_echo "$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







|
>

|







|
|















|
>

|


|


|











|
>

|




|
|
|
>
|
|
|
>

|









|
>

|







|
|







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
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
#	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
  tcl_ok=0
fi

    if test "$tcl_ok" = 1; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strtoul implementation" >&5
$as_echo_n "checking proper strtoul implementation... " >&6; }
if ${tcl_cv_strtoul_unbroken+:} false; then :

  $as_echo_n "(cached) " >&6
else
  if test "$cross_compiling" = yes; then :

  tcl_cv_strtoul_unbroken=unknown
else
  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
  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtoul_unbroken" >&5
$as_echo "$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







|
>

|




|
|
|
>
|
|
|
>

|










|
>

|







|
|







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
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

#--------------------------------------------------------------------
#	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

cat >>confdefs.h <<_ACEOF
#define mode_t int
_ACEOF

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






cat >>confdefs.h <<_ACEOF



#define pid_t int




_ACEOF











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

cat >>confdefs.h <<_ACEOF
#define size_t unsigned int
_ACEOF

fi

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for uid_t in sys/types.h" >&5
$as_echo_n "checking for uid_t in sys/types.h... " >&6; }
if ${ac_cv_type_uid_t+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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
  ac_cv_type_uid_t=no
fi
rm -f conftest*

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_uid_t" >&5
$as_echo "$ac_cv_type_uid_t" >&6; }
if test $ac_cv_type_uid_t = no; then

$as_echo "#define uid_t int" >>confdefs.h


$as_echo "#define gid_t int" >>confdefs.h

fi


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for socklen_t" >&5
$as_echo_n "checking for socklen_t... " >&6; }
if ${tcl_cv_type_socklen_t+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	#include <sys/types.h>
	#include <sys/socket.h>

int
main ()
{

    	socklen_t foo;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_type_socklen_t=yes
else
  tcl_cv_type_socklen_t=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_socklen_t" >&5
$as_echo "$tcl_cv_type_socklen_t" >&6; }
if test $tcl_cv_type_socklen_t = no; then

$as_echo "#define socklen_t int" >>confdefs.h

fi

ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default"
if test "x$ac_cv_type_intptr_t" = xyes; then :


$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h

else

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size signed integer type" >&5
$as_echo_n "checking for pointer-size signed integer type... " >&6; }
if ${tcl_cv_intptr_t+:} false; then :
  $as_echo_n "(cached) " >&6
else

    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))];
test_array [0] = 0;
return test_array [0];

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_ok=yes
else
  tcl_ok=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	    test "$tcl_ok" = yes && break; fi
    done
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intptr_t" >&5
$as_echo "$tcl_cv_intptr_t" >&6; }
    if test "$tcl_cv_intptr_t" != none; then

cat >>confdefs.h <<_ACEOF
#define intptr_t $tcl_cv_intptr_t
_ACEOF

    fi

fi


ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default"
if test "x$ac_cv_type_uintptr_t" = xyes; then :


$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h

else

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size unsigned integer type" >&5
$as_echo_n "checking for pointer-size unsigned integer type... " >&6; }
if ${tcl_cv_uintptr_t+:} false; then :
  $as_echo_n "(cached) " >&6
else

    for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
	    none; do
	if test "$tcl_cv_uintptr_t" != none; then
	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))];
test_array [0] = 0;
return test_array [0];

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_ok=yes
else
  tcl_ok=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	    test "$tcl_ok" = yes && break; fi
    done
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_uintptr_t" >&5
$as_echo "$tcl_cv_uintptr_t" >&6; }
    if test "$tcl_cv_uintptr_t" != none; then

cat >>confdefs.h <<_ACEOF
#define uintptr_t $tcl_cv_uintptr_t
_ACEOF

    fi

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_echo "#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.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking union wait" >&5
$as_echo_n "checking union wait... " >&6; }
if ${tcl_cv_union_wait+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
#include <sys/wait.h>
int
main ()
{

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
  tcl_cv_union_wait=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_union_wait" >&5
$as_echo "$tcl_cv_union_wait" >&6; }
if test $tcl_cv_union_wait = no; then

$as_echo "#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
  tcl_ok=0
fi

if test "$tcl_ok" = 0; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -lsocket" >&5
$as_echo_n "checking for strncasecmp in -lsocket... " >&6; }
if ${ac_cv_lib_socket_strncasecmp+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char strncasecmp ();
int
main ()
{
return strncasecmp ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_socket_strncasecmp=yes
else
  ac_cv_lib_socket_strncasecmp=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_strncasecmp" >&5
$as_echo "$ac_cv_lib_socket_strncasecmp" >&6; }
if test "x$ac_cv_lib_socket_strncasecmp" = xyes; then :

  tcl_ok=1
else
  tcl_ok=0
fi

fi
if test "$tcl_ok" = 0; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -linet" >&5
$as_echo_n "checking for strncasecmp in -linet... " >&6; }
if ${ac_cv_lib_inet_strncasecmp+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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.  */
#ifdef __cplusplus
extern "C"
#endif
char strncasecmp ();
int
main ()
{
return strncasecmp ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_lib_inet_strncasecmp=yes
else
  ac_cv_lib_inet_strncasecmp=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_strncasecmp" >&5
$as_echo "$ac_cv_lib_inet_strncasecmp" >&6; }
if test "x$ac_cv_lib_inet_strncasecmp" = xyes; then :

  tcl_ok=1
else
  tcl_ok=0
fi

fi
if test "$tcl_ok" = 0; then
    case " $LIBOBJS " in
  *" strncasecmp.$ac_objext "* ) ;;







|
>

|

<
|
<



>
|
>
|
>

|
>
>

>
>
>
|
>
>
>
|
>
>
>
>

>
>
>
>
>
>
>

>
>
>


>

|
>

|

<
|
<



|
|
|
>
|
|






|
>

|


|


|
|


|


|




|
|
|
>
|
|








|








|
>

|


|

|
|


|



|
<
|

<
|
<
|
<
<
<
<
<
|
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<

<

>
|
<
|

<
|
<
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|
<
<
<
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












|
>

|

|












|
|
|
>
|
|






|










|
>

|


|


|
|


|










|
>

|




|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|





|
|
|
>
|
|








<
<
<


|






|
>

|


|



|
|
|
>

|







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
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
#	   (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_echo "#define NO_GETTOD 1" >>confdefs.h


fi

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gettimeofday declaration" >&5
$as_echo_n "checking for gettimeofday declaration... " >&6; }
if ${tcl_cv_grep_gettimeofday+:} false; then :

  $as_echo_n "(cached) " >&6
else

    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
  tcl_cv_grep_gettimeofday=missing
fi
rm -f conftest*

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_gettimeofday" >&5
$as_echo "$tcl_cv_grep_gettimeofday" >&6; }
if test $tcl_cv_grep_gettimeofday = missing ; then

$as_echo "#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.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether char is unsigned" >&5
$as_echo_n "checking whether char is unsigned... " >&6; }
if ${ac_cv_c_char_unsigned+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{
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
  ac_cv_c_char_unsigned=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_char_unsigned" >&5
$as_echo "$ac_cv_c_char_unsigned" >&6; }
if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then
  $as_echo "#define __CHAR_UNSIGNED__ 1" >>confdefs.h

fi

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking signed char declarations" >&5
$as_echo_n "checking signed char declarations... " >&6; }
if ${tcl_cv_char_signed+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

	signed char *p;
	p = 0;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_char_signed=yes
else
  tcl_cv_char_signed=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_char_signed" >&5
$as_echo "$tcl_cv_char_signed" >&6; }
if test $tcl_cv_char_signed = yes; then

$as_echo "#define HAVE_SIGNED_CHAR 1" >>confdefs.h

fi

#--------------------------------------------------------------------
#  Does putenv() copy or not?  We need to know to avoid memory leaks.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a putenv() that copies the buffer" >&5
$as_echo_n "checking for a putenv() that copies the buffer... " >&6; }
if ${tcl_cv_putenv_copy+:} false; then :

  $as_echo_n "(cached) " >&6
else

    if test "$cross_compiling" = yes; then :

  tcl_cv_putenv_copy=no
else
  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[])







|
>

|


|




|
|
|
>
|
|







|
>

|


|


|
|


|









|
|
|
>
|
|




|









|
>

|


|

|
|
|
|



|
|
|
>
|
|





|









|
>

|


|

|
|


|







|
|
|
>
|
|

|
>

|







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
9537

9538
9539
9540
9541
9542
9543
9544
9545
9546
9547
9548
9549
9550
9551
9552
9553
9554
9555
9556
9557
9558
9559
9560
9561

9562
9563
9564
9565
9566
9567
9568
9569
9570
9571

9572
9573
9574
9575
9576
9577
9578
9579
9580
9581
9582

9583
9584
9585
9586
9587
9588
9589
9590
9591
9592
9593
9594
9595
9596
9597

9598
9599
9600
9601
9602
9603
9604
9605
9606
9607
9608
9609
9610
9611
9612
9613
9614
9615
9616
9617
9618
9619
9620
9621

9622
9623

9624

9625

9626
9627
9628
9629
9630
9631




9632

9633
9634
9635
9636
9637
9638
9639
9640
9641

9642
9643
9644
9645
9646
9647
9648
9649
9650
9651
9652
9653
9654
9655
9656
9657
9658

9659
9660
9661
9662
9663
9664
9665
9666
9667
9668
9669
9670
9671
9672
9673
9674
9675
9676
9677
9678
9679
9680
9681
9682
9683

9684
9685
9686
9687
9688
9689
9690
9691
9692
9693
9694

9695
9696
9697
9698
9699
9700
9701
9702
9703
9704
9705
9706

9707
9708
9709
9710
9711
9712
9713
9714
9715
9716
9717
9718

9719
9720
9721
9722
9723
9724
9725
9726
9727
9728
9729
9730

9731
9732
9733
9734
9735

9736
9737
9738
9739
9740
9741
9742
9743
9744
9745
9746
9747
9748
9749
9750
9751

9752
9753
9754
9755
9756
9757
9758
9759
9760
9761
9762

9763
9764
9765
9766
9767
9768
9769
9770
9771
9772
9773
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
10059
10060
10061
10062
10063
10064
10065
10066

10067
10068
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
10217
10218
10219
10220
10221
10222
10223
10224
10225
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
	    } else {
		/* does copy */
		return 1;
	    }
	}

_ACEOF
if ac_fn_c_try_run "$LINENO"; then :

  tcl_cv_putenv_copy=no
else
  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_putenv_copy" >&5
$as_echo "$tcl_cv_putenv_copy" >&6; }
if test $tcl_cv_putenv_copy = yes; then

$as_echo "#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+set}" = set; then :

  enableval=$enable_langinfo; langinfo_ok=$enableval
else
  langinfo_ok=yes
fi


    HAVE_LANGINFO=0
    if test "$langinfo_ok" = "yes"; then
	ac_fn_c_check_header_mongrel "$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
  langinfo_ok=no
fi


    fi
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use nl_langinfo" >&5
$as_echo_n "checking whether to use nl_langinfo... " >&6; }
    if test "$langinfo_ok" = "yes"; then
	if ${tcl_cv_langinfo_h+:} false; then :

  $as_echo_n "(cached) " >&6
else

	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <langinfo.h>
int
main ()
{
nl_langinfo(CODESET);
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_langinfo_h=yes
else
  tcl_cv_langinfo_h=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_langinfo_h" >&5
$as_echo "$tcl_cv_langinfo_h" >&6; }
	if test $tcl_cv_langinfo_h = yes; then

$as_echo "#define HAVE_LANGINFO 1" >>confdefs.h

	fi
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $langinfo_ok" >&5
$as_echo "$langinfo_ok" >&6; }
    fi


#--------------------------------------------------------------------
# Check for support of cfmakeraw, chflags and mkstemps functions
#--------------------------------------------------------------------


for ac_func in cfmakeraw chflags mkstemps
do :

  as_ac_var=`$as_echo "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 `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF

fi




done



#--------------------------------------------------------------------
# Check for support of isnan() function or macro
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking isnan" >&5
$as_echo_n "checking isnan... " >&6; }
if ${tcl_cv_isnan+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <math.h>
int
main ()
{

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
  tcl_cv_isnan=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_isnan" >&5
$as_echo "$tcl_cv_isnan" >&6; }
if test $tcl_cv_isnan = no; then

$as_echo "#define NO_ISNAN 1" >>confdefs.h

fi

#--------------------------------------------------------------------
# Darwin specific API checks and defines
#--------------------------------------------------------------------

if test "`uname -s`" = "Darwin" ; then
    for ac_func in getattrlist
do :
  ac_fn_c_check_func "$LINENO" "getattrlist" "ac_cv_func_getattrlist"
if test "x$ac_cv_func_getattrlist" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_GETATTRLIST 1
_ACEOF

fi
done

    for ac_header in copyfile.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "copyfile.h" "ac_cv_header_copyfile_h" "$ac_includes_default"
if test "x$ac_cv_header_copyfile_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_COPYFILE_H 1
_ACEOF

fi

done

    for ac_func in copyfile
do :
  ac_fn_c_check_func "$LINENO" "copyfile" "ac_cv_func_copyfile"
if test "x$ac_cv_func_copyfile" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_COPYFILE 1
_ACEOF

fi
done

    if test $tcl_corefoundation = yes; then
	for ac_header in libkern/OSAtomic.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "libkern/OSAtomic.h" "ac_cv_header_libkern_OSAtomic_h" "$ac_includes_default"
if test "x$ac_cv_header_libkern_OSAtomic_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_LIBKERN_OSATOMIC_H 1
_ACEOF

fi

done

	for ac_func in OSSpinLockLock
do :
  ac_fn_c_check_func "$LINENO" "OSSpinLockLock" "ac_cv_func_OSSpinLockLock"
if test "x$ac_cv_func_OSSpinLockLock" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_OSSPINLOCKLOCK 1
_ACEOF

fi
done


    fi

$as_echo "#define USE_VFORK 1" >>confdefs.h


$as_echo "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h


$as_echo "#define TCL_WIDE_CLICKS 1" >>confdefs.h

    for ac_header in AvailabilityMacros.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "AvailabilityMacros.h" "ac_cv_header_AvailabilityMacros_h" "$ac_includes_default"
if test "x$ac_cv_header_AvailabilityMacros_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_AVAILABILITYMACROS_H 1
_ACEOF

fi

done

    if test "$ac_cv_header_AvailabilityMacros_h" = yes; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if weak import is available" >&5
$as_echo_n "checking if weak import is available... " >&6; }
if ${tcl_cv_cc_weak_import+:} false; then :

  $as_echo_n "(cached) " >&6
else

	    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 ()
{
rand();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_cc_weak_import=yes
else
  tcl_cv_cc_weak_import=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
	    CFLAGS=$hold_cflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_weak_import" >&5
$as_echo "$tcl_cv_cc_weak_import" >&6; }
	if test $tcl_cv_cc_weak_import = yes; then

$as_echo "#define HAVE_WEAK_IMPORT 1" >>confdefs.h

	fi
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if Darwin SUSv3 extensions are available" >&5
$as_echo_n "checking if Darwin SUSv3 extensions are available... " >&6; }
if ${tcl_cv_cc_darwin_c_source+:} false; then :

  $as_echo_n "(cached) " >&6
else

	    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 ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_cc_darwin_c_source=yes
else
  tcl_cv_cc_darwin_c_source=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	    CFLAGS=$hold_cflags
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_darwin_c_source" >&5
$as_echo "$tcl_cv_cc_darwin_c_source" >&6; }
	if test $tcl_cv_cc_darwin_c_source = yes; then

$as_echo "#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)
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fts" >&5
$as_echo_n "checking for fts... " >&6; }
if ${tcl_cv_api_fts+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #include <sys/param.h>
	    #include <sys/stat.h>
	    #include <fts.h>

int
main ()
{

	    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
  tcl_cv_api_fts=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_fts" >&5
$as_echo "$tcl_cv_api_fts" >&6; }
if test $tcl_cv_api_fts = yes; then

$as_echo "#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.
#--------------------------------------------------------------------


    for ac_header in sys/ioctl.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_ioctl_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_SYS_IOCTL_H 1
_ACEOF

fi

done

    for ac_header in sys/filio.h
do :
  ac_fn_c_check_header_mongrel "$LINENO" "sys/filio.h" "ac_cv_header_sys_filio_h" "$ac_includes_default"
if test "x$ac_cv_header_sys_filio_h" = xyes; then :
  cat >>confdefs.h <<_ACEOF

#define HAVE_SYS_FILIO_H 1
_ACEOF

fi

done


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5
$as_echo_n "checking system version... " >&6; }
if ${tcl_cv_sys_version+:} false; then :

  $as_echo_n "(cached) " >&6
else

	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
		{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5
$as_echo "$tcl_cv_sys_version" >&6; }
    system=$tcl_cv_sys_version

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
$as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; }
    case $system in
	OSF*)

$as_echo "#define USE_FIONBIO 1" >>confdefs.h

	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5
$as_echo "FIONBIO" >&6; }
	    ;;
	*)
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5
$as_echo "O_NONBLOCK" >&6; }
	    ;;
    esac


#------------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use dll unloading" >&5
$as_echo_n "checking whether to use dll unloading... " >&6; }
# Check whether --enable-dll-unloading was given.
if test "${enable_dll_unloading+set}" = set; then :

  enableval=$enable_dll_unloading; tcl_ok=$enableval
else
  tcl_ok=yes
fi

if test $tcl_ok = yes; then

$as_echo "#define TCL_UNLOAD_DLLS 1" >>confdefs.h

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
$as_echo "$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.
#------------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for timezone data" >&5
$as_echo_n "checking for timezone data... " >&6; }

# Check whether --with-tzdata was given.
if test "${with_tzdata+set}" = set; then :

  withval=$with_tzdata; tcl_ok=$withval
else
  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)
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by OS vendor" >&5
$as_echo "supplied by OS vendor" >&6; }
    ;;
    yes)
	# nothing to do here
    ;;
    auto*)
	if ${tcl_cv_dir_zoneinfo+:} false; then :

  $as_echo_n "(cached) " >&6
else

	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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $dir" >&5
$as_echo "$dir" >&6; }
	else
	    tcl_ok=yes
	fi
    ;;
    *)
	as_fn_error $? "invalid argument: $tcl_ok" "$LINENO" 5
    ;;
esac
if test $tcl_ok = yes
then
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by Tcl" >&5
$as_echo "supplied by Tcl" >&6; }
    INSTALL_TZDATA=install-tzdata
fi

#--------------------------------------------------------------------
#	DTrace support
#--------------------------------------------------------------------

# Check whether --enable-dtrace was given.
if test "${enable_dtrace+set}" = set; then :

  enableval=$enable_dtrace; tcl_ok=$enableval
else
  tcl_ok=no
fi

if test $tcl_ok = yes; then
    ac_fn_c_check_header_mongrel "$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
  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_path_DTRACE+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DTRACE" >&5
$as_echo "$DTRACE" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi


    test -z "$ac_cv_path_DTRACE" && tcl_ok=no
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable DTrace support" >&5
$as_echo_n "checking whether to enable DTrace support... " >&6; }
MAKEFILE_SHELL='/bin/sh'
if test $tcl_ok = yes; then

$as_echo "#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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
$as_echo "$tcl_ok" >&6; }

#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
# Check whether --enable-zipfs was given.
if test "${enable_zipfs+set}" = set; then :
  enableval=$enable_zipfs; tcl_ok=$enableval
else
  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
        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
$as_echo_n "checking for gcc... " >&6; }
        if ${ac_cv_path_cc+:} false; then :
  $as_echo_n "(cached) " >&6
else

            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'
      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
$as_echo_n "checking for build system executable suffix... " >&6; }
if ${bfd_cv_build_exeext+:} false; then :
  $as_echo_n "(cached) " >&6
else
  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
$as_echo "$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
    #

    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
$as_echo_n "checking for zip... " >&6; }
    if ${ac_cv_path_zip+:} false; then :
  $as_echo_n "(cached) " >&6
else

    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"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
$as_echo "$ZIP_PROG" >&6; }
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="*"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
$as_echo "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}"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH. Building minizip" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
$as_echo_n "checking for building with zipfs... " >&6; }
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;

$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h

       INSTALL_LIBRARIES=install-libraries-zipfs-static
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
     else

$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
    fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi






#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the cpuid instruction is usable" >&5
$as_echo_n "checking whether the cpuid instruction is usable... " >&6; }
if ${tcl_cv_cpuid+:} false; then :

  $as_echo_n "(cached) " >&6
else

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

	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
  tcl_cv_cpuid=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cpuid" >&5
$as_echo "$tcl_cv_cpuid" >&6; }
if test $tcl_cv_cpuid = yes; then

$as_echo "#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.
#--------------------------------------------------------------------







|
>

|







|
|


|









|
>

|






|
|
>

|



<

|
|

|
>
|
|





|






|
>

|


|


|
|


|



|
|







>
|
|
>
|
>
|
>
|
|
<
<


>
>
>
>
|
>






|
|
|
>
|
|





|








|
>

|


|


|
|


|








<
<
|
|
<
>
|
<


<

<
<
|
|
<
>
|
<



<
<
<
<
|
|
<
>
|
<


<


<
<
|
|
<
>
|
<



<
<
<
<
|
|
<
>
|
<


|
>

<
<
|


|


|

<
<
|
|
<
>
|
<


<
<


|
|
|
>
|
|















|






|
>

|


|



|
|


|


|
|
|
>
|
|
















|






|
>

|


|


|
|


|















|
|
|
>
|
|









|










|
>

|


|


|
|


|










<
<
|
|
<
>
|
<



<
<
<
<
|
|
<
>
|
<



<

<
|
|
|
>
|
|






|
|












|
|


|
|



|

|
|


|
|






|
|

|
>

|





|


|
|







|
|


|
>

|









|
|





|
>
|
|















|
|










|
|








|
>

|




|
|
>

|


<





|
|
|
>
|
|










>
|
>
>
>

|
|
|











|
|

|
|





|
|



|

















|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<





|
|
|
>
|
|





|














|
>

|


|


|
|


|







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
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
# 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
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to package libraries" >&5
$as_echo_n "checking how to package libraries... " >&6; }
	# Check whether --enable-framework was given.
if test "${enable_framework+set}" = set; then :

  enableval=$enable_framework; enable_framework=$enableval
else
  enable_framework=no
fi

	if test $enable_framework = yes; then
	    if test $SHARED_BUILD = 0; then
		{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be built if --enable-shared is yes" >&5
$as_echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;}
		enable_framework=no
	    fi
	    if test $tcl_corefoundation = no; then
		{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be used when CoreFoundation is available" >&5
$as_echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;}
		enable_framework=no
	    fi
	fi
	if test $enable_framework = yes; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: framework" >&5
$as_echo "framework" >&6; }
	    FRAMEWORK_BUILD=1
	else
	    if test $SHARED_BUILD = 1; then
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result: shared library" >&5
$as_echo "shared library" >&6; }
	    else
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static library" >&5
$as_echo "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

$as_echo "#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







|
|

|
>

|





|
|



|
|




|
|



|
|

|
|


















|







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
10633
10634
10635
10636
10637
10638
10639
10640
10641
# 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_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$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







|
|







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
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
    esac |
    sort
) |
  sed '
     /^ac_cv_env_/b end
     t clear
     :clear
     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
     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
      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
$as_echo "$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
    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
$as_echo "$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}'







|






|
|













|
|







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
10742
10743
10744
10745
10746
10747
10748
10749
10750
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"
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
$as_echo "$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.







|
|







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

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
10891
10892
10893
10894
10895
10896
10897
10898
10899

10900
10901
10902
10903
10904
10905
10906
cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##

# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh

if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :

  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac
fi










as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '


    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi

  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'









fi





# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; 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


# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

# 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

  test -z "$as_dir" && as_dir=.



    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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH


# 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
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$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 ()
{







>
|
>






|









>
>
>
>
>
>
>
>



<
<
<
<
<
<
<
<
|
|
<
|
|
<
<
<
<
<
<
|
<
<
<
<
<
<
<
|
>
>
|
<
<
>
|
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>


|








<
<
<
<
<
<
<








>
|
>
>
>
|











|



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












|

|


>







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
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
# ---------------
# 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_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_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith









>






|
>




|











|
>




|







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
10987
10988
10989
10990
10991
10992
10993
10994
  as_dirname=false
fi

as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
	    s//\1/
	    q







|







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
11063
11064
11065
11066
11067
11068
11069
11070
11071
11072
11073
11074
11075
11076
11077
11078
11079
  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=`$as_echo "$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 ||
$as_echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q







|








|







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
11135
11136
11137
11138
11139
11140
11141
11142

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.69.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@








|







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
11189
11190
11191
11192
11193
11194
11195
11196
11197
11198
11199
11200
11201
11202

Configuration commands:
$config_commands

Report bugs to the package provider."

_ACEOF


cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
tcl config.status 9.0
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 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







>
>

|


|


|







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
11232
11233
11234
11235
11236
11237
11238
11239
11240
11241
11242
11243
11244
11245
11246
11247
11248
11249
11250
11251
11252
11253
  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 )
    $as_echo "$ac_cs_version"; exit ;;
  --config | --confi | --conf | --con | --co | --c )
    $as_echo "$ac_cs_config"; exit ;;
  --debug | --debu | --deb | --de | --d | -d )
    debug=: ;;
  --file | --fil | --fi | --f )
    $ac_shift
    case $ac_optarg in
    *\'*) ac_optarg=`$as_echo "$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 )
    $as_echo "$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." ;;







|

|





|





|







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
11274
11275
11276
11277
11278
11279
11280
11281
11282
11283
11284
11285
11286
11287
11288
11289
11290
11291
11292
11293
11294
11295
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
  \$as_echo "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
  $as_echo "$ac_log"
} >&5

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
#
# INIT-COMMANDS
#







|













|







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
11324
11325
11326
11327
11328
11329
11330
11331
11332


# 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+set}" = set || CONFIG_FILES=$config_files
  test "${CONFIG_COMMANDS+set}" = set || 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:







|
|







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
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
	 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=`$as_echo "$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 '`
	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
	`' by configure.'
    if test x"$ac_file" != x-; then
      configure_input="$ac_file.  $configure_input"
      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
$as_echo "$as_me: creating $ac_file" >&6;}
    fi
    # Neutralize special characters interpreted by sed in replacement strings.
    case $configure_input in #(
    *\&* | *\|* | *\\* )
       ac_sed_conf_input=`$as_echo "$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 ||
$as_echo X"$ac_file" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q







|







|



|
|




|
















|







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
11612
11613
11614
11615
11616
11617
11618
11619
11620
11621
	  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=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$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







|

|







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
11667
11668
11669
11670
11671
11672
11673
11674
11675
/@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@*)
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
$as_echo "$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







|
|







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
11710
11711
11712
11713
11714
11715
11716
11717
11718
11719
11720
11721
11722
11723
11724
11725
11726
11727
11728
11729
11730
11731
11732
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"; } &&
  { $as_echo "$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
$as_echo "$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)  { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5
$as_echo "$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 &&







|

|











|
|







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
11772
11773
11774
11775
11776

  $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
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi










|
|



>
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
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
#! /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_STRING
    /* override */ #undef PACKAGE_TARNAME

    #endif /* _TCLCONFIG */])
])

TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a2"






|












|
|
>







1
2
3
4
5
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
116
117
118
119
120
121
122
123
# 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_TRY_COMPILE(,, 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

#------------------------------------------------------------------------







|







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
175
176
177
178
179
180
181
182
183
184
AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])

#------------------------------------------------------------------------
#	Add stuff for libtommath

libtommath_ok=yes
AC_ARG_WITH(system-libtommath,
AC_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])])







|

|







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
304
305
306
307
308
309
310
311
312
#	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_TRY_COMPILE([#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>?])







|
|







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
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

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_TRY_COMPILE([
	#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_TYPE([intptr_t], [
    AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_intptr_t" != none; then
	AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
	   type wide enough to hold a pointer.])
    fi
])
AC_CHECK_TYPE([uintptr_t], [
    AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [
    for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
	    none; do
	if test "$tcl_cv_uintptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_uintptr_t" != none; then
	AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
	   type wide enough to hold a pointer.])
    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_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_TRY_LINK([#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







|


|

|




|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|



















|
|



|







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
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
#	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_TRY_COMPILE(, [
	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_TRY_RUN([
	#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







|


|









|


















|
|
|
|







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
589
590
591
592
593
594
595
596
597
598
AC_CHECK_FUNCS(cfmakeraw chflags mkstemps)

#--------------------------------------------------------------------
# Check for support of isnan() function or macro
#--------------------------------------------------------------------

AC_CACHE_CHECK([isnan], tcl_cv_isnan, [
    AC_TRY_LINK([#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
#--------------------------------------------------------------------







|

|







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
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
	[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_TRY_LINK([
		    #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_TRY_COMPILE([
		    #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_TRY_LINK([
	    #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,
    AC_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,
    AC_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







|








|
|







|









|



















|



|



|
















|















|







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
754
755
756
757
758
759
760
761
fi

#--------------------------------------------------------------------
#	DTrace support
#--------------------------------------------------------------------

AC_ARG_ENABLE(dtrace,
    AC_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])







|







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
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
	    # 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])

#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
AC_ARG_ENABLE(zipfs,
    AC_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_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?])
       INSTALL_LIBRARIES=install-libraries-zipfs-static
       AC_MSG_RESULT([yes])
     else
       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       AC_MSG_RESULT([yes])
    fi
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 check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [
    AC_TRY_LINK(, [
	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.









<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




|







|







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
28
29
30
31
32
33
34






35
36
37
38
39
40
41
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: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX}
	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
	@touch ../dltest.marker

dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX}
	@touch ../dltest.marker







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







|



|


>
>
>
>
>
>







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






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

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







pkga${SHLIB_SUFFIX}: pkga.o
	${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS}

pkgb${SHLIB_SUFFIX}: pkgb.o
	${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o ${SHLIB_LD_LIBS}

pkgc${SHLIB_SUFFIX}: pkgc.o
	${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o ${SHLIB_LD_LIBS}

pkgd${SHLIB_SUFFIX}: pkgd.o
	${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${SHLIB_LD_LIBS}

pkge${SHLIB_SUFFIX}: pkge.o
	${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${SHLIB_LD_LIBS}

pkgua${SHLIB_SUFFIX}: pkgua.o
	${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}

pkgooa${SHLIB_SUFFIX}: pkgooa.o
	${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS}




pkga${DLTEST_SUFFIX}: pkga.o
	${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS}

pkgb${DLTEST_SUFFIX}: pkgb.o
	${DLTEST_LD} -o pkgb${DLTEST_SUFFIX} pkgb.o ${SHLIB_LD_LIBS}

pkgc${DLTEST_SUFFIX}: pkgc.o
	${DLTEST_LD} -o pkgc${DLTEST_SUFFIX} pkgc.o ${SHLIB_LD_LIBS}

pkgd${DLTEST_SUFFIX}: pkgd.o
	${DLTEST_LD} -o pkgd${DLTEST_SUFFIX} pkgd.o ${SHLIB_LD_LIBS}

pkge${DLTEST_SUFFIX}: pkge.o
	${DLTEST_LD} -o pkge${DLTEST_SUFFIX} pkge.o ${SHLIB_LD_LIBS}

pkgua${DLTEST_SUFFIX}: pkgua.o
	${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}

pkgooa${DLTEST_SUFFIX}: pkgooa.o
	${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS}

clean:
	rm -f *.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







>
>
>
>
>
>
|
|

|
|

|
|

|
|

|
|

|
|

|
|

>
>
>
|
|

|
|

|
|

|
|

|
|

|
|

|
|


|











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
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 (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"






|







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
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;
}







|








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
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 (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"



|



|







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
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;







|







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
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;
}







|






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
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 (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"







|







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
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;







|







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
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;
}







|






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
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 (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"



|



|







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
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;







|







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
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;
}







|






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
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 (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"







|







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
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 (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tclOO.h"






|







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
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;
}







|






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
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 (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 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"







|
|







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
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);







|







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
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







|





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
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,
	    AC_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 )







|

|







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
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,
	    AC_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 )







|

|







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
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
#	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,
	AC_HELP_STRING([--enable-shared],
	    [build and link with shared libraries (default: on)]),
	[tcl_ok=$enableval], [tcl_ok=yes])

    if test "${enable_shared+set}" = set; then
	enableval="$enable_shared"
	tcl_ok=$enableval
    else
	tcl_ok=yes
    fi

    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?])







|


<
<
<
<
<
<
<
<







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
554
555
556
557
558
559
560
561
#		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,
	    AC_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







|







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
612
613
614
615
616
617
618
619
#		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,
	AC_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?])







|







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
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
#
#	Defines the following vars:
#		HAVE_LANGINFO	Triggers use of nl_langinfo if defined.
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_LANGINFO], [
    AC_ARG_ENABLE(langinfo,
	AC_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_TRY_COMPILE([#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







|










|
|







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
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
#			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,
	AC_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,
	AC_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,
	AC_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







|

|
|




|






|













|






|



















>







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
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

AC_DEFUN([SC_CONFIG_CFLAGS], [

    # Step 0.a: Enable 64 bit support?

    AC_MSG_CHECKING([if 64bit support is requested])
    AC_ARG_ENABLE(64bit,
	AC_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,
	AC_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_TRY_LINK([
	    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,
	AC_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.








|








|












|

>
|
|












|







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
974
975
976
977
978
979
980
981
    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 -Wdeclaration-after-statement"
		;;
	esac

    ], [
	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""
    ])







|







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
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
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*)
	    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_TRY_COMPILE([
		#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"







|














|



|
|
|







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
1293
1294
1295
1296
1297
1298
1299
1300
		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_TRY_LINK(,, 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
		])
	   ])








|







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

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
	    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_TRY_LINK(,, 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_TRY_LINK(,, 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_TRY_LINK(, [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_TRY_LINK(, [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,
		AC_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_TRY_LINK([#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_TRY_LINK([#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"







>
|
|










>
|
|


















>
|












>
|
|

















|
















|
|
|
|
















|
|
|
|







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
1732
1733
1734
1735
1736
1737
1738
1739
	    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_TRY_LINK(, [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=""
	    ;;







|







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
1759
1760
1761
1762
1763
1764
1765
1766
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,
	AC_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=""







|







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
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
    # 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_*) ;;
	    HP_UX*) ;;
	    Darwin-*) ;;
	    IRIX*) ;;
	    Linux*|GNU*) ;;
	    NetBSD-*|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],







|




|







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
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
    # 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_TRY_COMPILE([],
	    [
		  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






















    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(LDFLAGS)
    AC_SUBST(LDFLAGS_DEBUG)
    AC_SUBST(LDFLAGS_OPTIMIZE)
    AC_SUBST(CC_SEARCH_FLAGS)
    AC_SUBST(LD_SEARCH_FLAGS)








|
|
|

|
|
|
<
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
















>







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
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
#		HAVE_SYS_PARAM_H
#		HAVE_STRING_H ?
#
#--------------------------------------------------------------------

AC_DEFUN([SC_MISSING_POSIX_HEADERS], [
    AC_CACHE_CHECK([dirent.h], tcl_cv_dirent_h, [
    AC_TRY_LINK([#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)







|
|

















|







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
1976
1977
1978
1979
1980
1981
1982
1983
	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_HAVE_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







|







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
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
#--------------------------------------------------------------------

AC_DEFUN([SC_PATH_X], [
    AC_PATH_X
    not_really_there=""
    if test "$no_x" = ""; then
	if test "$x_includes" = ""; then
	    AC_TRY_CPP([#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_TRY_CPP([#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"







|









|







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
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
#		HAVE_TM_TZADJ
#		HAVE_TIMEZONE_VAR
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TIME_HANDLER], [
    AC_CHECK_HEADERS(sys/time.h)
    AC_HEADER_TIME

    AC_CHECK_FUNCS(gmtime_r localtime_r mktime)

    AC_CACHE_CHECK([tm_tzadj in struct tm], tcl_cv_member_tm_tzadj, [
	AC_TRY_COMPILE([#include <time.h>], [struct tm tm; 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_TRY_COMPILE([#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_TRY_COMPILE([#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_TRY_COMPILE([#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) and socket stuff (-lsocket vs.

#	-lnsl) or thread library (-lpthread) are dealt with here.
#
# Arguments:
#	None.
#
# Results:
#
#	Sets the following vars:







|




|
|
>





|
|
>









|
|

|
|







|
|

|
|










|
>
|







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

2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
#		_LARGEFILE64_SOURCE
#		_LARGEFILE_SOURCE64
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_EARLY_FLAG],[
    AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]),

	AC_TRY_COMPILE([$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,
	    AC_TRY_COMPILE([[#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],[







>
|
<
|
|
|







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
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
# Arguments:
#	None
#
# Results:
#
#	Might define the following vars:
#		TCL_WIDE_INT_IS_LONG
#		TCL_WIDE_INT_TYPE
#		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 the compiler knows natively about __int64
	AC_TRY_COMPILE(,[__int64 value = (__int64) 0;],
	    tcl_type_64bit=__int64, tcl_type_64bit="long long")
	# 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_TRY_COMPILE(,[switch (0) {
            case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ;
        }],tcl_cv_type_64bit=${tcl_type_64bit})])
    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
	AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit},
	    [What type should be used to define wide integers?])
	AC_MSG_RESULT([${tcl_cv_type_64bit}])

	# Now check for auxiliary declarations
	AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[
	    AC_TRY_COMPILE([#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_TRY_COMPILE([#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_TRY_COMPILE([#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_TRY_COMPILE([#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])







<










<
<
<



|
|
|




<
<
<
<


|
|
|





|
|
|
|





|
|
|







|
|
|







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
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
#	Will define the following vars:
#		TCL_CFGVAL_ENCODING
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_CFG_ENCODING], [
    AC_ARG_WITH(encoding,
	AC_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?])







|

|







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
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
#
#--------------------------------------------------------------------

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_TRY_RUN([[
#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







|


|
|







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
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

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_TRY_COMPILE([
	#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_TRY_COMPILE([
	    #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







|

|










|






|

|










|







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
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

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_TRY_COMPILE([
	#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_TRY_COMPILE([
	    #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_TRY_COMPILE([
		#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







|

|







|






|

|







|






|

|





|







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
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
#		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_TRY_COMPILE([
	#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_TRY_COMPILE([
	    #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







|


|






|






|


|






|







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
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
#		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_TRY_COMPILE([
	#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_TRY_COMPILE([
	    #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







|


|






|






|


|






|







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
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
#		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_TRY_COMPILE([
	#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_TRY_COMPILE([
	    #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







|


|






|






|


|






|







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
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
#		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_TRY_COMPILE([
	#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_TRY_COMPILE([
	    #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







|


|






|






|


|






|







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

3000
3001
3002
3003
3004
3005
3006

3007
3008
3009
3010
3011




















3012
3013
3014
3015
3016
3017
3018
#	Locate a zip encoder installed on the system path, or none.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:

#		ZIP_PROG
#       ZIP_PROG_OPTIONS
#       ZIP_PROG_VFSSEARCH
#       ZIP_INSTALL_OBJS
#------------------------------------------------------------------------

AC_DEFUN([SC_ZIPFS_SUPPORT], [

    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""





















    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







>
|






>





>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
8
9
10
11
12
13
14
15
# tcl pkg-config source file

prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@
libfile=@TCL_LIB_FILE@
zipfile=@TCL_ZIP_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@







<







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
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.0a1
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}







|







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
15
16
17




18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 * 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.
 */

#undef BUILD_tcl
#undef STATIC_BUILD
#include "tcl.h"





#ifdef TCL_TEST
extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */

#ifdef TCL_XT_TEST
extern void                XtToolkitInitialize(void);
extern Tcl_PackageInitProc 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.
 */







<
<

>
>
>
>


|
|




|







8
9
10
11
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
82

83
84
85
86
87
88
89
{
#ifdef TCL_XT_TEST
    XtToolkitInitialize();
#endif

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#else

    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}








|
>







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
127
128
129
130
131
132
133
134
    }
#endif

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(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) {







|







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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
     * 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:
 */







|


|













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
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

/* Define to 1 if you have the `gmtime_r' function. */
#undef HAVE_GMTIME_R

/* Compiler support for module scope symbols */
#undef HAVE_HIDDEN

/* Do we have the intptr_t type? */
#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 <memory.h> header file. */
#undef HAVE_MEMORY_H

/* 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. */







|

















<
<
<







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
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

/* Do we have the uintptr_t type? */
#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







|







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
400


401
402
403
404
405
406
407

/* Define to the version of this package. */
#undef PACKAGE_VERSION

/* Is this a static build? */
#undef STATIC_BUILD

/* Define to 1 if you have the ANSI C header files. */


#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







|
>
>







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
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454

/* 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

/* What type should be used to define wide integers? */
#undef TCL_WIDE_INT_TYPE

/* Tcl with external libtommath */
#undef TCL_WITH_EXTERNAL_TOMMATH

/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
#undef TIME_WITH_SYS_TIME

/* Is getcwd Posix-compliant? */
#undef USEGETWD

/* May we include <dirent2.h>? */
#undef USE_DIRENT2_H

/* Are we building with DTrace support? */







<
<
<



<
<
<







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
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

/* 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 you are not using gcc.  */

#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

/* Signed integer type wide enough to hold a pointer. */
#undef intptr_t

/* Define to `int' if <sys/types.h> does not define. */
#undef mode_t

/* Define to `int' if <sys/types.h> does not define. */
#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

/* Unsigned integer type wide enough to hold a pointer. */
#undef uintptr_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_STRING
    /* override */ #undef PACKAGE_TARNAME

    #endif /* _TCLCONFIG */







|
>













<
<
<



|











<
<
<




|
|
>

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
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 (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 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







|
|







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
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
				 * PlatformEventsFinalize. */
#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 */







|







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
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

/*
 * Forward declarations.
 */

static void		PlatformEventsControl(FileHandler *filePtr,
			    ThreadSpecificData *tsdPtr, int op, int isNew);
static void		PlatformEventsFinalize(void);
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 API.
 */

#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
 *	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
Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	PlatformEventsInit();
	return tsdPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
 *	This function is called to cleanup the notifier state before a thread
 *	is terminated.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If no finalizeNotifierProc notifier hook exists, PlatformEvents-
 *	Finalize is called.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FinalizeNotifier(
    ClientData clientData)
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
	PlatformEventsFinalize();
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsControl --
 *
 *	This function registers interest for the file descriptor and the mask







<




|

|







|







|
|





|

<
<
<
|

|
|
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
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
 *	- 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.
 *
 *----------------------------------------------------------------------
 */

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) {







|


















|
>








|







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
280
281
282
283
284
285
286
287
	Tcl_Panic("epoll_ctl: %s", strerror(errno));
   }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsFinalize --
 *
 *	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:







|







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
302
303
304
305
306
307
308
309
310
 *
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsFinalize(
	void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
#ifdef HAVE_EVENTFD
    if (tsdPtr->triggerEventFd) {
	close(tsdPtr->triggerEventFd);







|
|







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
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
 *	  PlatformEventsControl().
 *	- readyEvents and maxReadyEvents are initialised with 512
 *	  epoll_events.
 *
 *----------------------------------------------------------------------
 */

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);
}

/*
 *----------------------------------------------------------------------







|









|




















|







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
419
420
421
422
423
424
425
426
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsTranslate(
    struct epoll_event *eventPtr)
{
    int mask;

    mask = 0;
    if (eventPtr->events & (EPOLLIN | EPOLLHUP)) {







|







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
460
461
462
463
464
465
466
467
 *	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.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsWait(
    struct epoll_event *events,
    size_t numEvents,
    struct timeval *timePtr)
{
    int numFound;
    struct timeval tv0, tv1, tv_delta;







|







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
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672

673

674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777

778
779
780
781
782

783
784
785
786
787
788
789
790
791
792
793
794

795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828


829
830
831
832
833
834
835
836
837
     */

    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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	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
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. */
{
    int isNew;

    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	FileHandler *filePtr;

	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;
	}
	filePtr->proc = proc;
	filePtr->clientData = clientData;
	filePtr->mask = mask;

	PlatformEventsControl(filePtr, tsdPtr,
		isNew ? EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	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
Tcl_DeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    if (tclNotifierHooks.deleteFileHandlerProc) {
	tclNotifierHooks.deleteFileHandlerProc(fd);
	return;
    } else {
	FileHandler *filePtr, *prevPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * 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;
	    }
	    if (filePtr->fd == fd) {
		break;
	    }
	}

	/*
	 * 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);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	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.
 *
 *	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
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)	/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
	/*

	 * 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.
	 */

	struct timeval timeout, *timeoutPtr;
	int 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;
		tclScaleTimeProcPtr(&vTime, tclTimeClientData);
		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(
			    "Tcl_WaitForEvent: read from %p->triggerEventFd: %s",
			    (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(
			    "Tcl_WaitForEvent: read from %p->triggerPipe[0]: %s",
			    (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 */


#endif /* !HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|

|










|
















|















|









<
<
<
<
<
<
|
|
|
<
<
<
<
|
<
|
|
|
|
|
|
<
<
<
|
|
|
|

|
|
|
|
<



|

















|



<
<
<
<
|
|

|
|
|

<
|
|
|
<
<
<
<
|

|
|
|

|
|
|
|

|
|
|

|
|
|
|
|
|
<





|


|















|


<
<
<
|
<
|
<
>
|
>
|
|
<
|
<
|
|
|
|
|

|
|
|
<
|

|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
<
|

|
|
|
|
|
|
|
|
|

|
|
|
|

|
|
|

|
|
|
|
|
|
|

|
|
|
|
|

|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
<
|

|
|
|
|
>
|
|

|
|
>
|
<
|
<
|
|
|
|
|

|
|
>
|
|
|
<
|
|
|
|
|

|
|
|

|
|
|
|

|
|
|

|
|
|
|
|
|
|
|
|
<

>
>









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
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 (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 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








|
|







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
34

35
36
37
38
39
40
41
/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
 */

struct PlatformEventData;
typedef struct FileHandler {
    int fd;

    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. */







|
>







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
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
				/* 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
				 * PlatformEventsFinalize. */
    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 void		PlatformEventsFinalize(void);
static void		PlatformEventsInit(void);
static int		PlatformEventsTranslate(struct kevent *eventPtr);
static int		PlatformEventsWait(struct kevent *events,
			    size_t numEvents, struct timeval *timePtr);

#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
 *	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
Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	PlatformEventsInit();
	return tsdPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
 *	This function is called to cleanup the notifier state before a thread
 *	is terminated.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If no finalizeNotifierProc notifier hook exists, PlatformEvents-
 *	Finalize is called.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FinalizeNotifier(
    ClientData clientData)
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
	PlatformEventsFinalize();
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsControl --
 *
 *	This function registers interest for the file descriptor and the mask







|

















<
<



|
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
|
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<







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
212
213
214
215
216
217
218
219
220
221
222
223
224
225

226
227
228
229
230
231
232
 *	  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.)
 *
 *----------------------------------------------------------------------
 */

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







|












|
>







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
260
261
262
263
264
265
266
267
268
269
270
271
272
	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));







|




|







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
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
	 * 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;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsFinalize --
 *
 *	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:







|





|












|







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
328
329
330
331
332
333
334
335
336
 *
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsFinalize(
    void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
    if (tsdPtr->triggerPipe[0]) {
	close(tsdPtr->triggerPipe[0]);
	tsdPtr->triggerPipe[0] = -1;







|
|







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
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
	Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsInit --


 *
 *	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:
 *	None.
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsInit(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int i, fdFl;
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
    if (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
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
	}
    }
    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);


}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

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.







|





|



>
>



















|




















|







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
486
487
488
489
490
491
492
493
 *	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.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsWait(
    struct kevent *events,
    size_t numEvents,
    struct timeval *timePtr)
{
    int numFound;
    struct timeval tv0, tv1, tv_delta;







|







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
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699

700

701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844


845
846
847
848
849
850
851
852
853
    }
    return numFound;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	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
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. */
{
    int isNew;

    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	FileHandler *filePtr;

	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;
	}
	filePtr->proc = proc;
	filePtr->clientData = clientData;
	filePtr->mask = mask;

	PlatformEventsControl(filePtr, tsdPtr, EV_ADD, isNew);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	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
Tcl_DeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    if (tclNotifierHooks.deleteFileHandlerProc) {
	tclNotifierHooks.deleteFileHandlerProc(fd);
	return;
    } else {
	FileHandler *filePtr, *prevPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * 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;
	    }
	    if (filePtr->fd == fd) {
		break;
	    }
	}

	/*
	 * 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);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	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.
 *
 *	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
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
	/*

	 * 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.
	 */

	struct timeval timeout, *timeoutPtr;
	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;
		tclScaleTimeProcPtr(&vTime, tclTimeClientData);
		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 PlatformEvents-
	 * Wait() 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 */


#endif /* !HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|















|









<
<
<
<
<
<
|
|
|
<
<
<
<
|
<
|
|
|
|
|
|
<
<
<
|
|
|
|

|
|
|
<



|

















|



|
<
<
<
|
<

|
|
|

<
|
|
|
<
<
<
<
|

|
|
|

|
|
|
|

|
|
|

|
|
|
|
|
|
<





|


|















|
|

<
<
<
|
|
|
<
>
|
>
|
|
<
|
<
|
|
|
|
|
|

|
|
|
<
|

|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|

|
|
|
|

|
|
|

|
|
|
|
|
|
|

|
|
|
|
|

|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|

|
|
|

|
|
|
|
|
|
|
|
|
<

>
>









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
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 (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH
 *	Not derived from licensed software.
 *
 *	Permission is granted to freely use, copy, modify, and redistribute
 *	this software, provided that the author is not construed to be liable
 *	for any results of using the software, alterations are clearly marked
 *	as such, and this notice is not modified.
 *
 * 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 (c) 1992 HELIOS Software GmbH
 * 30159 Hannover, Germany
 */

#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <stdlib.h>











|













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
/*
 * 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
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 (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"
#ifdef NO_DLFCN_H






|







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
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
				 * that represents the loaded file. */
{
    void *handle = loadHandle->clientData;

    dlclose(handle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    TCL_UNUSED(const char *) /*fileName*/,
    TCL_UNUSED(Tcl_DString *))
{
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








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
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 (c) 1995 Apple Computer, Inc.
 * Copyright (c) 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"









|
|







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
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_PackageInitProc *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_PackageInitProc *)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;







|







|







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
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_PackageInitProc *)NSAddressOfSymbol(nsSymbol);
	}
	Tcl_DStringFree(&newName);
#endif /* TCL_DYLD_USE_NSMODULE */
    }
    Tcl_DStringFree(&ds);
    if (errMsg && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|







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
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
	    Tcl_Free(ptr);
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }
    Tcl_Free(dyldLoadHandle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    TCL_UNUSED(const char *) /*fileName*/,
    TCL_UNUSED(Tcl_DString *) /*bufPtr*/)
{
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpLoadMemoryGetBuffer --
 *
 *	Allocate a buffer that can be used with TclpLoadMemory() below.







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
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 (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"
#include <mach-o/rld.h>






|







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
136
137
138
139
140
141
142
143

static void *
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{
    Tcl_PackageInitProc *proc = NULL;

    if (symbol) {
	char sym[strlen(symbol) + 2];

	sym[0] = '_';
	sym[1] = 0;
	strcat(sym, 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
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
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);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








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
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 (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"
#include <sys/types.h>







|







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
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_PackageInitProc *) 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_PackageInitProc *) 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)));







|











|







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
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
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);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this function is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name.  A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








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
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 (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 <dl.h>
#include "tclInt.h"







|







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
131
132
133
134
135
136
137
138
static void*
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{
    Tcl_DString newName;
    Tcl_PackageInitProc *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.
     */








|







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
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
				 * that represents the loaded file. */
{
    shl_t handle = (shl_t) loadHandle->clientData;

    shl_unload(handle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








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
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 (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"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is







|







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
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 {







|
|







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
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);







|
|







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
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
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__ */





#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
 *	Initializes the platform specific notifier state.
 *
 * 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 {
	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
	    pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif /* __CYGWIN__ */
	    tsdPtr->waitCVinitialized = 1;
	}

	pthread_mutex_lock(&notifierInitMutex);
#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: pthread_atfork failed");
	    }
	    atForkInit = 1;
	}
#endif /* HAVE_PTHREAD_ATFORK */

	notifierCount++;
	pthread_mutex_unlock(&notifierInitMutex);

#endif /* TCL_THREADS */
	return tsdPtr;
    }

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
 *	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
Tcl_FinalizeNotifier(
    ClientData clientData)
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	pthread_mutex_lock(&notifierInitMutex);
	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(&notifierMutex);
	    while(triggerPipe != -1) {
		pthread_cond_wait(&notifierCV, &notifierMutex);
	    }
	    pthread_mutex_unlock(&notifierMutex);
	    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(&notifierInitMutex);
#endif /* TCL_THREADS */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	This function registers a file handler with the select notifier.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure.
 *
 *----------------------------------------------------------------------
 */

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);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	FileHandler *filePtr;

	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	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;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	Cancel a previously-arranged callback arrangement for a file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered on file, remove it.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    if (tclNotifierHooks.deleteFileHandlerProc) {
	tclNotifierHooks.deleteFileHandlerProc(fd);
	return;
    } else {
	FileHandler *filePtr, *prevPtr;
	int i;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * 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;
	    }
	    if (filePtr->fd == fd) {
		break;
	    }
	}

	/*
	 * 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,







|
>
>
>
|





|













|

<
<
<
|


|

|
|
|
>
|

|

|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|

|
|

|

|
|
|
|

|
|

|
|
|
|
|


|
|
<

<
|
>





|















|
|

<
<
<
<

|

|
|

|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|


|
|
|
|

|

|

<





|













|









<
<
<
<
|
|

<
<
<
<
<
<
|
|
|
|
|
|
|
|
|
|

|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<






|













|



|
<
<
<
|
|
<

|
|
|

<
|
|
|
<
<
<
<
|

|
|
|

|
|
|
|
|
|
|
|
|

|
|
|

|
|

|
|
|
|
|
|
|
|
|
|

|
|
|

|
|
|
|
|
|
<







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(&notifierInitMutex);
#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(&notifierInitMutex);

#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(&notifierInitMutex);
    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(&notifierMutex);
	while(triggerPipe != -1) {
	    pthread_cond_wait(&notifierCV, &notifierMutex);
	}
	pthread_mutex_unlock(&notifierMutex);
	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(&notifierInitMutex);
#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
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712

713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920

921
922
923
924
925
926
927
    return 0;
}
#endif /* TCL_THREADS && __CYGWIN__ */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	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
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	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;
		tclScaleTimeProcPtr(&vTime, tclTimeClientData);
		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(&notifierMutex);

	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(&notifierMutex);
		MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
		pthread_mutex_lock(&notifierMutex);
	    }
#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, &notifierMutex, &ptime);
	    } else {
		pthread_cond_wait(&tsdPtr->waitCV, &notifierMutex);
	    }
#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(&notifierMutex);
#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 never exits. It dies with the overall
 *	process.

 *
 * Side effects:
 *	The trigger pipe used to signal the notifier thread is created when
 *	the notifier thread first starts.
 *
 *----------------------------------------------------------------------
 */







|















|


<
<
<
|
|
|
|

|

|


|
|
|
|
|

|
|


|
|
|
<
|

|
|
|
|
|
|

|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|

|
|
|

|


|
|
|
|
|
>
|

|

|

|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|

|
|
|

|

|
|

|
|
|
|
|
|
|
|
|

|
|
|

|
|
|
|

|
|
|
|

|
|


|
|
|
|

|

|
|
|
|
|
|
|
|
|


|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|

|
|
|
|

|
|
|
|
|


|
|
|

|
|
|
|
|
|
|
|
|
|
|
|

|
|
|

|
|
|
|

|
|
|

|
|
|
|
|
|

|

|
<
















|
|
>







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(&notifierMutex);

    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(&notifierMutex);
	    MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
	    pthread_mutex_lock(&notifierMutex);
	}
#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, &notifierMutex, &ptime);
	} else {
	    pthread_cond_wait(&tsdPtr->waitCV, &notifierMutex);
	}
#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(&notifierMutex);
#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
1051
1052
1053
1054
1055
1056
1057
1058
	 * Alert any threads that are waiting on a ready file descriptor.
	 */

	pthread_mutex_lock(&notifierMutex);
	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)) {







|







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(&notifierMutex);
	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(&notifierMutex);

    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(&notifierMutex);

    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
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 (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"	/* Internal definitions for Tcl. */
#include "tclIO.h"	/* To get Channel type declaration. */






|
|







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
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,
			    Tcl_WideInt length);
static Tcl_WideInt	FileWideSeekProc(void *instanceData,
			    Tcl_WideInt 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,







|
|
|







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

277


278

279
280
281
282
283
284
285
286
287
288
289
    /*
     * 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.
     */


    bytesRead = read(fsPtr->fd, buf, toRead);


    if (bytesRead >= 0) {

	return bytesRead;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * FileOutputProc--
 *







>
|
>
>
|
>
|

<
|







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
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
 * Side effects:
 *	Moves the location at which the channel will be accessed in future
 *	operations.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
FileWideSeekProc(
    void *instanceData,	/* File state. */
    Tcl_WideInt 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;
    Tcl_WideInt newLoc;

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    *errorCodePtr = (newLoc == -1) ? errno : 0;
    return newLoc;
}








|


|





|







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
1976
1977
1978
1979
1980
1981
1982
1983
 *
 *----------------------------------------------------------------------
 */

static int
FileTruncateProc(
    void *instanceData,
    Tcl_WideInt length)
{
    FileState *fsPtr = (FileState *)instanceData;
    int result;

#ifdef HAVE_TYPE_OFF64_T
    /*
     * We assume this goes with the type for now...







|







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
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 h_errno;

    return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
			   sizeof(tsdPtr->hbuf), &h_errno);

#elif defined(HAVE_GETHOSTBYNAME_R_6)
    struct hostent *hePtr = NULL;
    int h_errno, result;

    result = gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
	    sizeof(tsdPtr->hbuf), &hePtr, &h_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;







|


|



|


|







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
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 h_errno;

    return gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
	    sizeof(tsdPtr->hbuf), &h_errno);

#elif defined(HAVE_GETHOSTBYADDR_R_8)
    struct hostent *hePtr;
    int h_errno;

    return (gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
		sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0)
	    ? &tsdPtr->hent : NULL;
#else
#define NEED_COPYHOSTENT 1
    struct hostent *hePtr;

    Tcl_MutexLock(&compatLock);
    hePtr = gethostbyaddr(addr, length, type);







|


|



|


|







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
6
7
8
9
10
11
12
13
/*
 * tclUnixEvent.c --
 *
 *	This file implements Unix specific event related routines.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is





|







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
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

	if (vdelay.usec < 0) {
	    vdelay.usec += 1000000;
	    vdelay.sec  -= 1;
	}

	if ((vdelay.sec != 0) || (vdelay.usec != 0)) {
	    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
	}

	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);
    }
}



#endif /* HAVE_COREFOUNDATION */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|




















>
>








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
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 (c) 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 (c) 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







|







|







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
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 = TclGetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	groupPtr = TclpGetGrNam(native); /* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (groupPtr == NULL) {
	    if (interp != NULL) {







|







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
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 = TclGetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (pwPtr == NULL) {
	    if (interp != NULL) {







|







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
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 = TclGetStringFromObj(pathPtr, &pathLen);
    Tcl_DString ds;
    const char *nativePath;
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
#endif

    currentPathEndPosition = path + nextCheckpoint;







|







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
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 = TclGetStringFromObj(dirObj, &length);
	Tcl_UtfToExternalDString(NULL, string, length, &templ);
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */
    }

    TclDStringAppendLiteral(&templ, "/");

    if (basenameObj) {
	string = TclGetStringFromObj(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 = TclGetStringFromObj(extensionObj, &length);
	Tcl_UtfToExternalDString(NULL, string, length, &tmp);
	TclDStringAppendDString(&templ, &tmp);
	fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {







|









|











|







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
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. */
{
    TclWinConvertError(GetLastError());
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
	    TclGetString(fileName), Tcl_PosixError(interp)));
}

static WCHAR *
winPathFromObj(
    Tcl_Obj *fileName)







|







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
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 (c) 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"






|







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
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, PATH_MAX);
    cygwin_conv_path(3, buf, name, PATH_MAX);
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
	/* Strip '.exe' part. */
	length -= 4;
    }
    encoding = Tcl_GetEncoding(NULL, NULL);
    TclSetObjNameOfExecutable(







|
|







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
964
965
966
967
968
969
970
971
	     * -- these must be expanded first).
	     */

	    transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr);
	    if (transPtr == NULL) {
		return NULL;
	    }
	    target = TclGetStringFromObj(transPtr, &length);
	    target = Tcl_UtfToExternalDString(NULL, target, length, &ds);
	    Tcl_DecrRefCount(transPtr);

	    if (symlink(target, src) != 0) {
		toPtr = NULL;
	    }
	    Tcl_DStringFree(&ds);







|







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
1118
1119
1120
1121
1122
1123
1124
1125
	validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (validPathPtr == NULL) {
	    return NULL;
	}
	Tcl_IncrRefCount(validPathPtr);
    }

    str = TclGetStringFromObj(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;







|







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
6
7
8
9
10
11
12
13
14
/*
 * tclUnixInit.c --
 *
 *	Contains the Unix-specific interpreter initialization functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 * All rights reserved.
 */

#include "tclInt.h"
#ifdef HAVE_LANGINFO
#   include <langinfo.h>
#   ifdef __APPLE__





|
|







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
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 11
static const char *const processors[NUMPROCESSORS] = {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
};

typedef struct {
  union {
    unsigned int  dwOemId;
    struct {
      int wProcessorArchitecture;







|

|
|







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
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 = TclGetStringFromObj(pathPtr, lengthPtr);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, str, *lengthPtr + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------







|







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
888
889
890
891
892
893
894
895
896
	    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);
    }







|
<







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
5

6
7
8

9
10
11
12
13
14
15
/*
 * tclUnixNotfy.c --
 *
 *	This file contains subroutines shared by all notifier backend
 *	implementations on *nix platforms.

 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 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 <poll.h>
#include "tclInt.h"




|
>

|
|
>







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
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
 *	None.
 *
 * Side effects:
 *	Running Thread.
 *
 *----------------------------------------------------------------------
 */

static void
StartNotifierThread(const char *proc)

{
    if (!notifierThreadRunning) {
	pthread_mutex_lock(&notifierInitMutex);
	if (!notifierThreadRunning) {
	    if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
		    TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
		Tcl_Panic("%s: unable to start notifier thread", proc);
	    }

	    pthread_mutex_lock(&notifierMutex);

	    /*
	     * Wait for the notifier pipe to be created.
	     */

	    while (triggerPipe < 0) {
		pthread_cond_wait(&notifierCV, &notifierMutex);
	    }
	    pthread_mutex_unlock(&notifierMutex);

	    notifierThreadRunning = 1;
	}
	pthread_mutex_unlock(&notifierInitMutex);
    }
}
#endif /* NOTIFIER_SELECT */

/*
 *----------------------------------------------------------------------
 *
 * 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 on a
 *	given notifier after Tcl_FinalizeNotifier is called for that notifier.
 *
 * Results:







>

|
>










>



















|







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(&notifierInitMutex);
	if (!notifierThreadRunning) {
	    if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
		    TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
		Tcl_Panic("%s: unable to start notifier thread", proc);
	    }

	    pthread_mutex_lock(&notifierMutex);

	    /*
	     * Wait for the notifier pipe to be created.
	     */

	    while (triggerPipe < 0) {
		pthread_cond_wait(&notifierCV, &notifierMutex);
	    }
	    pthread_mutex_unlock(&notifierMutex);

	    notifierThreadRunning = 1;
	}
	pthread_mutex_unlock(&notifierInitMutex);
    }
}
#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
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
 *	kqueue(2) notifier:
 *		write(2)s to the trigger pipe(2) of the specified thread.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AlertNotifier(
    ClientData clientData)
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;

	pthread_mutex_lock(&notifierMutex);
	tsdPtr->eventReady = 1;

#   ifdef __CYGWIN__
	PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#   else
	pthread_cond_broadcast(&tsdPtr->waitCV);
#   endif /* __CYGWIN__ */
	pthread_mutex_unlock(&notifierMutex);
#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 */
    }


















































}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimer --
 *
 *	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
Tcl_SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
{
    if (tclNotifierHooks.setTimerProc) {
	tclNotifierHooks.setTimerProc(timePtr);
	return;
    } else {
	/*
	 * 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
Tcl_ServiceModeHook(
    int mode)			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    } else if (mode == TCL_SERVICE_ALL) {
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
	StartNotifierThread("Tcl_ServiceModeHook");
#endif
#endif /* NOTIFIER_SELECT */
    }
}







|


<
<
<
<


|

|
|


|

|

|


|

|
>
|
|
|
|
|

|
|
|
|


|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|















|
|

<
<
<
<
|
|
|
|
|
<



















|



<
<
<
|







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(&notifierMutex);
    tsdPtr->eventReady = 1;

#   ifdef __CYGWIN__
    PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#   else
    pthread_cond_broadcast(&tsdPtr->waitCV);
#   endif /* __CYGWIN__ */
    pthread_mutex_unlock(&notifierMutex);
#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
417
418
419
420
421
422
423
424
425
426
427
428
429
	     */
	}
    }

    Tcl_InitNotifier();
}
#endif /* HAVE_PTHREAD_ATFORK */

#endif /* TCL_THREADS */

#endif /* NOTIFIER_SELECT */
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
/*
 *----------------------------------------------------------------------
 *
 * TclUnixWaitForFile --
 *
 *	This function waits synchronously for a file to become readable or
 *	writable, with an optional timeout.







<

<

|
<







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
566
567
568
569
570
571
572
573
574
575
	 */

	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:
 */







<

|







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
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 (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|
|







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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
 */

#include <sys/file.h>
#ifdef HAVE_SYS_SELECT_H
#   include <sys/select.h>
#endif
#include <sys/stat.h>
#ifdef TIME_WITH_SYS_TIME
#   include <sys/time.h>
#   include <time.h>
#else
#ifdef HAVE_SYS_TIME_H
#   include <sys/time.h>
#else
#   include <time.h>
#endif
#endif
#ifndef NO_SYS_WAIT_H
#   include <sys/wait.h>
#endif
#ifdef HAVE_INTTYPES_H
#   include <inttypes.h>
#endif
#include <limits.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
6
7
8
9
10
11
12
13
/*
 * tclUnixSock.c --
 *
 *	This file contains Unix-specific socket related code.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"






|







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
6
7
8
9
10
11
12
13
14
/*
 * tclUnixTest.c --
 *
 *	Contains platform specific test commands for the Unix platform.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS





|
|







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
6
7
8
9
10
11
12
13
14
15
/*
 * tclUnixThrd.c --
 *
 *	This file implements the UNIX-specific thread support.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2008 by 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"






|
|
|







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
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 (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL)






|







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
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
/*
 * 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.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetSeconds(void)
{
    return time(NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetMicroseconds --
 *
 *	This procedure returns the number of microseconds from the epoch.
 *	On most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
 *
 * Results:
 *	Number of microseconds from the epoch.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
TclpGetMicroseconds(void)
{
    Tcl_Time time;

    tclGetTimeProcPtr(&time, tclTimeClientData);
    return ((Tcl_WideInt)time.sec)*1000000 + time.usec;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetClicks --
 *







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


















|


|



















|




|
|







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
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetClicks(void)
{
	Tcl_WideUInt now;

#ifdef NO_GETTOD
    if (tclGetTimeProcPtr != NativeGetTime) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);

	now = (Tcl_WideUInt)time.sec*1000000 + time.usec;
    } else {
	/*
	 * A semi-NativeGetTime, specialized to clicks.
	 */
	struct tms dummy;

	now = (Tcl_WideUInt) times(&dummy);
    }
#else
    Tcl_Time time;

    tclGetTimeProcPtr(&time, tclTimeClientData);
    now = (Tcl_WideUInt)time.sec*1000000 + time.usec;
#endif

    return now;
}
#ifdef TCL_WIDE_CLICKS

/*
 *----------------------------------------------------------------------







|


|


|


|
>
|






|

|


|
|
|







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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
TclpGetWideClicks(void)
{
    Tcl_WideInt now;

    if (tclGetTimeProcPtr != NativeGetTime) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);
	now = ((Tcl_WideInt)time.sec)*1000000 + time.usec;
    } else {
#ifdef MAC_OSX_TCL
	now = (Tcl_WideInt) (mach_absolute_time() & INT64_MAX);
#else
#error Wide high-resolution clicks not implemented on this platform
#endif
    }

    return now;
}

/*
 *----------------------------------------------------------------------







|


|

|


|
|


|


|







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
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
 *	None.
 *
 *----------------------------------------------------------------------
 */

double
TclpWideClicksToNanoseconds(
    Tcl_WideInt clicks)
{
    double nsec;

    if (tclGetTimeProcPtr != NativeGetTime) {
	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
    }

    return nsec;
}

/*
 *----------------------------------------------------------------------







|



|

















|







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
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
 *
 *----------------------------------------------------------------------
 */

double
TclpWideClickInMicrosec(void)
{
    if (tclGetTimeProcPtr != NativeGetTime) {
	return 1.0;
    } else {
#ifdef MAC_OSX_TCL
	static int initialized = 0;
	static double scale = 0.0;

	if (initialized) {
	    return scale;
	} else {
	    mach_timebase_info_data_t tb;

	    mach_timebase_info(&tb);
	    /* value of tb.numer / tb.denom = 1 click in nanoseconds */
	    scale = ((double)tb.numer) / tb.denom / 1000;
	    initialized = 1;
	    return scale;
	}

#else
#error Wide high-resolution clicks not implemented on this platform
#endif
    }
}
#endif /* TCL_WIDE_CLICKS */

/*
 *----------------------------------------------------------------------
 *







|






|
<
<




|

<

>


|







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
290
291
292
293
294
295
296
297
 *----------------------------------------------------------------------
 */

void
Tcl_GetTime(
    Tcl_Time *timePtr)		/* Location to store time information. */
{
    tclGetTimeProcPtr(timePtr, tclTimeClientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimeProc --
 *







|







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
7
8
9
10
11
12
13
14
/*
 * tclXtNotify.c --
 *
 *	This file contains the notifier driver implementation for the Xt
 *	intrinsics.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS






|







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
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.
	 */








|







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
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;







|







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
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.
     */








|







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
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.
     */







|







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
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 (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <X11/Intrinsic.h>
#include "tcl.h"

static Tcl_ObjCmdProc TesteventloopCmd;
extern DLLEXPORT Tcl_PackageInitProc Tclxttest_Init;

/*
 * Functions defined in tclXtNotify.c for use by users of the Xt Notifier:
 */

extern void	InitNotifier(void);
extern XtAppContext	TclSetAppContext(XtAppContext ctx);





|












|







1
2
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
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
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		= tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE		= tclreg$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclreg$(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.3 [list load [file normalize ${DDE_DLL_FILE}] dde];\
			  package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] registry]
TEST_LOAD_FACILITIES	= package ifneeded Tcltest ${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)
MAN2TCL			= man2tcl$(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@







|

|
|




|
|
|










<







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
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
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)"
	@( \
	  $(LN) $$(find $(TOP_DIR)/library/* -maxdepth 0 -type f) ${TCL_VFS_PATH}/ && \
	  (for D in $$(find $(TOP_DIR)/library/* -maxdepth 0 -type d); do \
	    mkdir -p "${TCL_VFS_PATH}/$$(basename $$D)"; \
	    $(LN) -s $$D/* ${TCL_VFS_PATH}/$$(basename $$D)/; \
	  done) && \
	  $(LN) ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl && \
	  $(LN) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde/ && \
	  $(LN) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg/ \
	) || ( \
	  $(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}/reg; \
	)
	(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)
	$(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@






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}
	@$(RM) ${TCL_STUB_LIB_FILE}
	@MAKE_STUB_LIB@ ${STUB_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} ${DDE_OBJS} ${REG_OBJS}
	@$(RM) ${TCL_LIB_FILE}
	@MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@POST_MAKE_LIB@

${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
	@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest

${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
	@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest








<
<
<
<
<
<
<
<
<



|








|




>
>
>
>
>










|

|













|




|







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
652
653
654
655
656
657
658
659
660
661
662
663

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 \
	-DCFG_RUNTIME_PATH="\"$(bindir_native)\"" \
	-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
	-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
	-DCFG_RUNTIME_LIBDIR="\"$(bindir_native)\"" \
	-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
	$(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







<
<
<
<
<







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
682
683
684
685
686
687
688
689









690
691
692
693
694
695
696
697
698
699
700
701
702
703
		\
		-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)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_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 @DEPARG@ $(CC_OBJNAME)

tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

tclOOStubLib.${OBJEXT}: tclOOStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @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







<







>
>
>
>
>
>
>
>
>



|


|







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
794
795
796
797
798
799
800
801
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) "$$i"; \
		chmod 755 "$$i"; \
		else true; \
		fi; \
	    done;
	@for i in dde${DDEDOTVER} reg${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;







|







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
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
	    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)/reg${REGDOTVER}"; \
	    $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
		"$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \
	    fi
	@if [ -f $(REG_LIB_FILE) ]; then \
	    echo Installing $(REG_LIB_FILE); \
	    $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \
	    fi

install-libraries-zipfs-shared: libraries

install-libraries-zipfs-static: install-libraries-zipfs-shared
	$(COPY) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"

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"; \







|
|
|



|


<
<
<
<
<







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
887
888
889
890
891
892
893
894
895
896
897
	@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.3 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.3.tm";
	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.14.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;








|
|
|
|







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
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003

depend:

Makefile: $(SRC_DIR)/Makefile.in
	./config.status

cleanhelp:
	$(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe

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
	$(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT}
	$(RM) *.zip
	$(RMDIR) *.vfs

distclean: distclean-packages clean
	$(RM) Makefile config.status config.cache config.log tclConfig.sh \
		tcl.hpj config.status.lineno tclsh.exe.manifest

#
# Bundled package targets
#

PKG_CFG_ARGS		= @PKG_CFG_ARGS@
PKG_DIR			= ./pkgs







|




|

<




|







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
1125
1126
1127

.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: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile

# DO NOT DELETE THIS LINE -- make depend depends on it.







|


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
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,msvcrt
if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error

set OPTS=
set SYMBOLS=
goto end








|
|







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
3
4
5
6
7
8
9
10
11
12
13
14
15
16

17

18
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
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##

# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh

if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :

  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac
fi










as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '


    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi

  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'









fi





# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; 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


# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

# 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

  test -z "$as_dir" && as_dir=.



    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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH

# 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


|


|










>
|
>






|









>
>
>
>
>
>
>
>



<
<
<
<
<
<
<
<
|
|
<
|
|
<
<
<
<
<
<
|
<
<
<
<
<
<
<
|
>
>
|
<
<
>
|
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>


|








<
<
<
<
<
<
<








>
|
>
>
>
|











|



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
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'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
as_fn_exit 255
  fi
  # We don't want this to propagate to other subprocesses.
          { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :


  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '\${1+\"\$@\"}'='\"\$@\"'
  setopt NO_GLOB_SUBST
else
  case \`(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
  exitcode=1; echo positional parameters were not saved.
fi
test x\$exitcode = x0 || 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_have_required=no
fi
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :


else
  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

  test -z "$as_dir" && as_dir=.



  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_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :

  CONFIG_SHELL=$as_shell as_have_required=yes
		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :

  break 2
fi
fi
	   done;;
       esac
  as_found=false
done





$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :

  CONFIG_SHELL=$SHELL as_have_required=yes
fi; }
IFS=$as_save_IFS



      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'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
fi

    if test x$as_have_required = xno; then :

  $as_echo "$0: This script requires a shell more modern than all"
  $as_echo "$0: the shells that I found on your system."
  if test x${ZSH_VERSION+set} = xset ; then
    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
  else
    $as_echo "$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







|
|




|
>
>






|



















|
>

|



>
>






|
>

|


|
>

|





>
|
>
>
>





|

|
>

|
>







>
>
>
>
>
|
|
>

|
<
>


|
>

















|



|
>
|
|
|
|
|

|







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
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset


# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit









# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(
      *\'*) as_qdir=`$as_echo "$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 ||
$as_echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q







>


















>
>
>
>
>
>
>
>














|








|







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
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
} # 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_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_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith










# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
{
  as_status=$1; test $as_status -eq 0 && as_status=1
  if test "$4"; then
    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$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







|
>




|











|
>




|






>
>
>
>
>
>
>
>











|

|







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
442
443
444
445
446
447
448
449
  as_dirname=false
fi

as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
	    s//\1/
	    q







|







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
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
      N
      :loop
      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
      t loop
      s/-\n.*//
    ' >$as_me.lineno &&
  chmod +x "$as_me.lineno" ||
    { $as_echo "$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
}





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







|













>
>
>
>












>
>
>
>
>
>
>







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
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
LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME=
PACKAGE_TARNAME=
PACKAGE_VERSION=
PACKAGE_STRING=
PACKAGE_BUGREPORT=
PACKAGE_URL=

ac_unique_file="../generic/tcl.h"
# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif
#ifdef STDC_HEADERS
# include <stdlib.h>
# include <stddef.h>
#else
# ifdef HAVE_STDLIB_H
#  include <stdlib.h>
# endif
#endif
#ifdef HAVE_STRING_H
# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
#  include <memory.h>
# endif
# include <string.h>
#endif
#ifdef HAVE_STRINGS_H
# include <strings.h>
#endif
#ifdef HAVE_INTTYPES_H
# include <inttypes.h>
#endif
#ifdef HAVE_STDINT_H
# include <stdint.h>
#endif









#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif"


ac_subst_vars='LTLIBOBJS
LIBOBJS
RES
RC_DEFINES
RC_DEFINE
RC_INCLUDE
RC_TYPE







|
|
|
|
|
|




|
|
|

|
<
<
<

<
<
<
<
<


<
<
<


<
<
<






>
>
>
>
>
>
>
>
>




>







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
729
730
731
732
733
734
735
736
737
738
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
EGREP
GREP
CPP
OBJEXT
EXEEXT
ac_ct_CC
CPPFLAGS
LDFLAGS
CFLAGS
CC







>
>
>



















>











<
<
<







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
837
838
839
840
841
842
843
844
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}'
infodir='${datarootdir}/info'
htmldir='${docdir}'
dvidir='${docdir}'
pdfdir='${docdir}'
psdir='${docdir}'
libdir='${exec_prefix}/lib'
localedir='${datarootdir}/locale'







>


|







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
864
865
866
867
868
869
870
871
872

  case $ac_option in
  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
  *=)   ac_optarg= ;;
  *)    ac_optarg=yes ;;
  esac

  # Accept the important Cygnus configure options, so we can diagnose typos.

  case $ac_dashdash$ac_option in
  --)
    ac_dashdash=yes ;;

  -bindir | --bindir | --bindi | --bind | --bin | --bi)
    ac_prev=bindir ;;
  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)







<
<







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
906
907
908
909
910
911
912
913
914
915
  | --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=`$as_echo "$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







|

|







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
932
933
934
935
936
937
938
939
940
941
  -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=`$as_echo "$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







|

|







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
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
  -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=`$as_echo "$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=`$as_echo "$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







|

|













|

|







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
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
      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.
    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
      $as_echo "$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" ;;
    *)     $as_echo "$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
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;;







|

|















|







|







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
1280
1281
1282
1283
1284
1285
1286
1287
  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 ||
$as_echo X"$as_myself" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q







|







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
1337
1338
1339
1340
1341
1342
1343
1344
#
# 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 this package 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.







|







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
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397


1398
1399
1400
1401
1402
1403
1404
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]
  --docdir=DIR            documentation root [DATAROOTDIR/doc/PACKAGE]
  --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



  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)







>








|











|
>
>







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
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
      { 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=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$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







|

|







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
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
    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 guested configure.

    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
      $as_echo "$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
configure
generated by GNU Autoconf 2.69

Copyright (C) 2012 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
  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\""
$as_echo "$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
  $as_echo "$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_echo "$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_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\""
$as_echo "$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
  $as_echo "$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_echo "$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_try_run LINENO
# ----------------------
# Try to link 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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; }; then :
  ac_retval=0
else
  $as_echo "$as_me: program exited with status $ac_status" >&5
       $as_echo "$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_header_mongrel LINENO HEADER VAR INCLUDES
# -------------------------------------------------------
# Tests whether HEADER exists, giving a warning if it cannot be compiled using
# the include files in INCLUDES and setting the cache variable VAR
# accordingly.
ac_fn_c_check_header_mongrel ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  if eval \${$3+:} false; then :
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
else
  # Is the header compilable?
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
$as_echo_n "checking $2 usability... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
#include <$2>
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  ac_header_compiler=yes
else
  ac_header_compiler=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
$as_echo "$ac_header_compiler" >&6; }

# Is the header present?
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
$as_echo_n "checking $2 presence... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <$2>
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :
  ac_header_preproc=yes
else
  ac_header_preproc=no
fi
rm -f conftest.err conftest.i conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
$as_echo "$ac_header_preproc" >&6; }

# So?  What about this header?
case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
  yes:no: )
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
    ;;
  no:yes:* )
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     check for missing prerequisite headers?" >&5
$as_echo "$as_me: WARNING: $2:     check for missing prerequisite headers?" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&5
$as_echo "$as_me: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
    ;;
esac
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  eval "$3=\$ac_header_compiler"
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_header_mongrel

# 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
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  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
  eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  eval "$3=no"
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main ()
{
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 ()
{
if (sizeof (($2)))
	    return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :


else
  eval "$3=yes"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_type
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 $as_me, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
## Platform. ##







|
>







|








|
|

|
















|






|







|



|
>

|
|








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>













|







|



>
|

|
|








|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
|
|
<
<
<
<
|
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

<
|
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
|
<
|
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
>
|
<
<
<
<
<
<
<
<
<
<

<




|
|

|







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

1834



1835
1836
1837
1838
1839
1840
1841
1842

_ASUNAME

as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS

  test -z "$as_dir" && as_dir=.



    $as_echo "PATH: $as_dir"
  done
IFS=$as_save_IFS

} >&5

cat >&5 <<_ACEOF








>
|
>
>
>
|







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
1870
1871
1872
1873
1874
1875
1876
1877
  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=`$as_echo "$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.







|







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
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928

# 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

    $as_echo "## ---------------- ##
## 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_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$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







>
>




|










|
|







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
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
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
      ;;
    esac |
    sort
)
    echo

    $as_echo "## ----------------- ##
## Output variables. ##
## ----------------- ##"
    echo
    for ac_var in $ac_subst_vars
    do
      eval ac_val=\$$ac_var
      case $ac_val in
      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      esac
      $as_echo "$ac_var='\''$ac_val'\''"
    done | sort
    echo

    if test -n "$ac_subst_files"; then
      $as_echo "## ------------------- ##
## File substitutions. ##
## ------------------- ##"
      echo
      for ac_var in $ac_subst_files
      do
	eval ac_val=\$$ac_var
	case $ac_val in
	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	esac
	$as_echo "$ac_var='\''$ac_val'\''"
      done | sort
      echo
    fi

    if test -s confdefs.h; then
      $as_echo "## ----------- ##
## confdefs.h. ##
## ----------- ##"
      echo
      cat confdefs.h
      echo
    fi
    test "$ac_signal" != 0 &&
      $as_echo "$as_me: caught signal $ac_signal"
    $as_echo "$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

$as_echo "/* confdefs.h */" > confdefs.h

# Predefined preprocessor variables.

cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_URL "$PACKAGE_URL"
_ACEOF


# Let the site file select an alternate cache file if it wants to.
# Prefer an explicitly selected file to automatically selected ones.
ac_site_file1=NONE
ac_site_file2=NONE
if test -n "$CONFIG_SITE"; then
  # We do not want a PATH search for config.site.
  case $CONFIG_SITE in #((
    -*)  ac_site_file1=./$CONFIG_SITE;;
    */*) ac_site_file1=$CONFIG_SITE;;
    *)   ac_site_file1=./$CONFIG_SITE;;
  esac
elif test "x$prefix" != xNONE; then
  ac_site_file1=$prefix/share/config.site
  ac_site_file2=$prefix/etc/config.site
else
  ac_site_file1=$ac_default_prefix/share/config.site
  ac_site_file2=$ac_default_prefix/etc/config.site
fi

for ac_site_file in "$ac_site_file1" "$ac_site_file2"
do
  test "x$ac_site_file" = xNONE && continue





  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
$as_echo "$as_me: loading site script $ac_site_file" >&6;}
    sed 's/^/| /' "$ac_site_file" >&5
    . "$ac_site_file" \
      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
$as_echo "$as_me: loading cache $cache_file" >&6;}
    case $cache_file in
      [\\/]* | ?:[\\/]* ) . "$cache_file";;
      *)                      . "./$cache_file";;
    esac
  fi
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
$as_echo "$as_me: creating cache $cache_file" >&6;}
  >$cache_file
fi






























































































































































































































































































































# 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,)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
      ac_cache_corrupted=: ;;
    ,set)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
$as_echo "$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
	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
	  ac_cache_corrupted=:
	else
	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
	  eval $ac_var=\$ac_old_val
	fi
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
$as_echo "$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=`$as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}

  as_fn_error $? "run \`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.







|







|

|




|







|

|





|







|
|













|



<
|
<

<
|
<

<
|
<

<
|
<

<
|
<

<
|
<




<
<

<
|
<
<
<
<

|
<

|
<

>
|

|
>
>
>
>
>
|
|
|


|
|









|
|






|
|



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










|
|


|
|








|
|


|
|


|
|
|
|





|









|
|
|
|
>
|










>







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
2207
2208
2209

2210
2211
2212
2213
2214
2215
2216
2217
2218

2219



2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249

2250
2251
2252
2253
2254
2255
2256
2257
2258

2259



2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302

2303
2304
2305
2306
2307
2308
2309
2310
2311

2312



2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342

2343
2344
2345
2346
2347
2348
2349
2350
2351
2352

2353



2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401

2402
2403
2404
2405
2406
2407
2408
2409
2410

2411



2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445

2446
2447
2448
2449
2450
2451
2452
2453
2454

2455



2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491








































































































2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570

2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606

2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640

2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728

2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753

2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779

2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796

2797
2798
2799
2800
2801
2802
2803
2804
2805
2806


2807
2808
2809
2810
2811
2812
2813
2814
2815
2816

2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834

2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849

2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865

2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893




























































































2894

2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955

2956
2957
2958
2959
2960
2961
2962
2963
2964
2965

2966
2967
2968
2969
2970
2971
2972
2973
2974

2975
2976
2977
2978









2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991

2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005

3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417

3418
3419
3420
3421
3422
3423
3424
3425
3426

3427



3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457

3458
3459
3460
3461
3462
3463
3464
3465
3466

3467



3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509

3510
3511
3512
3513
3514
3515
3516
3517
3518

3519



3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549

3550
3551
3552
3553
3554
3555
3556
3557
3558

3559



3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601

3602
3603
3604
3605
3606
3607
3608
3609
3610

3611



3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641

3642
3643
3644
3645
3646
3647
3648
3649
3650

3651



3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697

3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739

3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764

3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801

3802
3803
3804










3805
3806
3807
3808
3809
3810
3811
3812

3813
3814

3815

3816
3817
3818
3819
3820
3821
3822
3823

3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842

3843
3844
3845
3846
3847
3848
3849
3850
3851

3852



3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880

3881
3882
3883
3884
3885
3886
3887
3888
3889

3890



3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924

3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942

3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
#------------------------------------------------------------------------

# 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi

  if test "x$ac_ct_CC" = x; then
    CC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_CC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    CC=$ac_ct_CC
  fi








































































































fi

fi


test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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.
$as_echo "$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; 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\""
$as_echo "$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
  $as_echo "$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 ()
{

  ;
  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.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
$as_echo_n "checking whether the C compiler works... " >&6; }
ac_link_default=`$as_echo "$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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link_default") 2>&5
  ac_status=$?
  $as_echo "$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+set}" = set && 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
  ac_file=''
fi
if test -z "$ac_file"; then :

  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
$as_echo_n "checking for C compiler default output file name... " >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
$as_echo_n "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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$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_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
$as_echo "$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 ()
{
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.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
$as_echo_n "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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  $as_echo "$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
	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot run C compiled programs.
If you meant to cross compile, use \`--host'.
See \`config.log' for more details" "$LINENO" 5; }
    fi
  fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
$as_echo "$cross_compiling" >&6; }

rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
ac_clean_files=$ac_clean_files_save
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
$as_echo_n "checking for suffix of object files... " >&6; }
if ${ac_cv_objext+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  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\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_compile") 2>&5
  ac_status=$?
  $as_echo "$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_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
$as_echo "$ac_cv_objext" >&6; }
OBJEXT=$ac_cv_objext
ac_objext=$OBJEXT
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
if ${ac_cv_c_compiler_gnu+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{
#ifndef __GNUC__
       choke me
#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  ac_compiler_gnu=yes
else
  ac_compiler_gnu=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
$as_echo "$ac_cv_c_compiler_gnu" >&6; }


if test $ac_compiler_gnu = yes; then
  GCC=yes
else
  GCC=
fi
ac_test_CFLAGS=${CFLAGS+set}
ac_save_CFLAGS=$CFLAGS
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
$as_echo_n "checking whether $CC accepts -g... " >&6; }
if ${ac_cv_prog_cc_g+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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 ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  ac_cv_prog_cc_g=yes
else
  CFLAGS=""
      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :


else
  ac_c_werror_flag=$ac_save_c_werror_flag
	 CFLAGS="-g"
	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

  ;
  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.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
   ac_c_werror_flag=$ac_save_c_werror_flag
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
$as_echo "$ac_cv_prog_cc_g" >&6; }
if test "$ac_test_CFLAGS" = set; 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }




























































































if ${ac_cv_prog_cc_c89+:} false; then :

  $as_echo_n "(cached) " >&6
else
  ac_cv_prog_cc_c89=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdarg.h>
#include <stdio.h>
struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
struct buf { int x; };
FILE * (*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 don't provoke an error unfortunately, instead are silently treated
   as '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's necessary to write '\x00'==0 to get something
   that's 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 **, FILE *(*)(struct buf *, struct stat *, int), int, int);
int argc;
char **argv;
int
main ()
{
return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
  ;
  return 0;
}
_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
  test "x$ac_cv_prog_cc_c89" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC

fi
# AC_CACHE_VAL

case "x$ac_cv_prog_cc_c89" in
  x)
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
$as_echo "none needed" >&6; } ;;
  xno)
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
$as_echo "unsupported" >&6; } ;;
  *)
    CC="$CC $ac_cv_prog_cc_c89"

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
esac
if test "x$ac_cv_prog_cc_c89" != xno; then :










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


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5
$as_echo_n "checking for inline... " >&6; }
if ${ac_cv_c_inline+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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 () {return 0; }
$ac_kw foo_t foo () {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.$ac_ext
  test "$ac_cv_c_inline" != no && break
done

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5
$as_echo "$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

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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
$as_echo_n "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 ${ac_cv_prog_CPP+:} false; then :
  $as_echo_n "(cached) " >&6
else
      # Double quotes because CPP needs to be expanded
    for CPP in "$CC -E" "$CC -E -traditional-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.
  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
  # <limits.h> exists even on freestanding compilers.
  # 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.  */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
		     Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :

else
  # 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
  # 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
$as_echo "$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.
  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
  # <limits.h> exists even on freestanding compilers.
  # 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.  */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
		     Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :

else
  # 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
  # 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_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$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


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
if ${ac_cv_path_GREP+:} false; then :
  $as_echo_n "(cached) " >&6
else
  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
  test -z "$as_dir" && as_dir=.
    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
  $as_echo_n 0123456789 >"conftest.in"
  while :
  do
    cat "conftest.in" "conftest.in" >"conftest.tmp"
    mv "conftest.tmp" "conftest.in"
    cp "conftest.in" "conftest.nl"
    $as_echo '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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
$as_echo "$ac_cv_path_GREP" >&6; }
 GREP="$ac_cv_path_GREP"


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
$as_echo_n "checking for egrep... " >&6; }
if ${ac_cv_path_EGREP+:} false; then :
  $as_echo_n "(cached) " >&6
else
  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
  test -z "$as_dir" && as_dir=.
    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
  $as_echo_n 0123456789 >"conftest.in"
  while :
  do
    cat "conftest.in" "conftest.in" >"conftest.tmp"
    mv "conftest.tmp" "conftest.in"
    cp "conftest.in" "conftest.nl"
    $as_echo '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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
$as_echo "$ac_cv_path_EGREP" >&6; }
 EGREP="$ac_cv_path_EGREP"


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
$as_echo_n "checking for ANSI C header files... " >&6; }
if ${ac_cv_header_stdc+:} false; then :
  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <float.h>

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  ac_cv_header_stdc=yes
else
  ac_cv_header_stdc=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

if test $ac_cv_header_stdc = yes; then
  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <string.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "memchr" >/dev/null 2>&1; then :

else
  ac_cv_header_stdc=no
fi
rm -f conftest*

fi

if test $ac_cv_header_stdc = yes; then
  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdlib.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "free" >/dev/null 2>&1; then :

else
  ac_cv_header_stdc=no
fi
rm -f conftest*

fi

if test $ac_cv_header_stdc = yes; then
  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
  if test "$cross_compiling" = yes; then :
  :
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <ctype.h>
#include <stdlib.h>
#if ((' ' & 0x0FF) == 0x020)
# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
#else
# define ISLOWER(c) \
		   (('a' <= (c) && (c) <= 'i') \
		     || ('j' <= (c) && (c) <= 'r') \
		     || ('s' <= (c) && (c) <= 'z'))
# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
#endif

#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
int
main ()
{
  int i;
  for (i = 0; i < 256; i++)
    if (XOR (islower (i), ISLOWER (i))
	|| toupper (i) != TOUPPER (i))
      return 2;
  return 0;
}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :

else
  ac_cv_header_stdc=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
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
$as_echo "$ac_cv_header_stdc" >&6; }
if test $ac_cv_header_stdc = yes; then

$as_echo "#define STDC_HEADERS 1" >>confdefs.h

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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_AR+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
$as_echo "$AR" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_AR+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
$as_echo "$ac_ct_AR" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi

  if test "x$ac_ct_AR" = x; then
    AR=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_RANLIB+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
$as_echo "$RANLIB" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
$as_echo "$ac_ct_RANLIB" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi

  if test "x$ac_ct_RANLIB" = x; then
    RANLIB=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_RC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RC" >&5
$as_echo "$RC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_RC+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5
$as_echo "$ac_ct_RC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi

  if test "x$ac_ct_RC" = x; then
    RC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$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.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
set x ${MAKE-make}
ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'`
if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
  SET_MAKE=
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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+set}" = set; then :

  withval=$with_encoding; with_tcencoding=${withval}
fi


    if test x"${with_tcencoding}" != x ; then
	cat >>confdefs.h <<_ACEOF
#define TCL_CFGVAL_ENCODING "${with_tcencoding}"
_ACEOF

    else
	$as_echo "#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.
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
$as_echo_n "checking how to build libraries... " >&6; }
    # Check whether --enable-shared was given.
if test "${enable_shared+set}" = set; then :

  enableval=$enable_shared; tcl_ok=$enableval
else
  tcl_ok=yes
fi


    if test "${enable_shared+set}" = set; then
	enableval="$enable_shared"
	tcl_ok=$enableval
    else
	tcl_ok=yes
    fi

    if test "$tcl_ok" = "yes" ; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5
$as_echo "shared" >&6; }
	SHARED_BUILD=1
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
$as_echo "static" >&6; }
	SHARED_BUILD=0

$as_echo "#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.
#--------------------------------------------------------------------

# On IRIX 5.3, sys/types and inttypes.h are conflicting.
for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
		  inttypes.h stdint.h unistd.h

do :
  as_ac_Header=`$as_echo "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 `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF

fi


done






    # Step 0: Enable 64 bit support?

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5
$as_echo_n "checking if 64bit support is requested... " >&6; }
    # Check whether --enable-64bit was given.
if test "${enable_64bit+set}" = set; then :

  enableval=$enable_64bit; do64bit=$enableval
else
  do64bit=no
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5
$as_echo "$do64bit" >&6; }

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""

$as_echo "#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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CYGPATH+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5
$as_echo "$CYGPATH" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi


    # Extract the first word of "wine", so it can be a program name with args.
set dummy wine; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_WINE+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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

  test -z "$as_dir" && as_dir=.



    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"
    $as_echo "$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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5
$as_echo "$WINE" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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

      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5
$as_echo_n "checking for cross-compile version of gcc... " >&6; }
if ${ac_cv_cross+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #ifndef _WIN32
		#error cross-compiler
	    #endif

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  ac_cv_cross=no
else
  ac_cv_cross=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5
$as_echo "$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"







>
>
>
>
>
>
>
>
>









|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|








|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|







|
|












|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|








|
|
|
>
|
|








>
|
>
>
>

|
|




|















|






|
|

|
|










|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|












|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|











|
|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|
|




|


|






|









|







|











|
|
|




















|


|
|
>
















|















|


|
>
|
|
|


|
|


|
|
|

|
|
|
|




|
|






|


|
|
>













|
|
|




|
|








|











|
|







|


|







|


|






|
|
|





|
|



|
|
|
>
|
|




|













|


|
|
>








|
|


|
|





|
|


|
|
|
>
|
|




|









|
>

|


|



|
|
>
>





|

|
|
|
>
|
|








|






|
>

|





|






|
>

|






|






|
>


|

|

|


|
|
|














|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<





|
>


|







>
|
|
|
|
|
|
|
|
|
>
|
|

|
>
>
>
>
>
>
>
>
>










|
|
|
>
|
|






|
|



|
>


|




|
|
















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|








|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|







|
|











|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|








|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|







|
|











|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|








|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|







|
|













|
|

|
|
>
|
|















|
|


|
|


















|
>





<
|
<


|










|
|

|
>

|



<
<
<
<
<
<
<
<

|
|


|
|


|











<
|
<
>
|
|
|
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|

|

>
|

>

>




|
|

|
>

|



|
|




|




|
|
|
>
|
|







>
|
>
>
>

|

|











|
|

|
|





|
|
|
>
|
|







>
|
>
>
>

|

|










|
|

|
|












|
|
|
>
|
|








|






|
>

|


|


|
|







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
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019

4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037

4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054

4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085

4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117

4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133






















4134

4135












































4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173

    if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
	conftest=/tmp/conftest.rc
	echo "STRINGTABLE BEGIN" > $conftest
	echo "101 \"name\"" >> $conftest
	echo "END" >> $conftest

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows native path bug in windres" >&5
$as_echo_n "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=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; } ; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "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"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mingw32 version of gcc" >&5
$as_echo_n "checking for mingw32 version of gcc... " >&6; }
if ${ac_cv_win32+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

		#ifdef _WIN32
		    #error win32
		#endif

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  ac_cv_win32=no
else
  ac_cv_win32=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5
$as_echo "$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"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working -municode linker flag" >&5
$as_echo_n "checking for working -municode linker flag... " >&6; }
if ${ac_cv_municode+:} false; then :

  $as_echo_n "(cached) " >&6
else

# 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$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\""
$as_echo "$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
  $as_echo "$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_echo "$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 ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  ac_cv_municode=yes
else
  ac_cv_municode=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_municode" >&5
$as_echo "$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






















    fi














































    { $as_echo "$as_me:${as_lineno-$LINENO}: checking compiler flags" >&5
$as_echo_n "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
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
$as_echo "using static flags" >&6; }
	    runtime=
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s.exe"
	else
	    # dynamic
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
$as_echo "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








|
|





|

|
|

|
|

















|
|
|
>
|
|








|






|
>

|


|


|
|





|
|
|
>
|
|







|






|







|






>
|

|
|




















|






|
>

|


|



|
|






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|




















|
|





|
|







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
4206
4207
4208
4209
4210
4211
4212
4213
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
		;;
	esac

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-o \$@"
	CC_EXENAME="-o \$@"








|







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
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
	#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
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
		;;
	    ia64)
		MACHINE="IA64"
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
		;;
	    *)
		cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

		    #ifndef _WIN64
			#error 32-bit
		    #endif

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_win_64bit=yes
else
  tcl_win_64bit=no

fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
		if test "$tcl_win_64bit" = "yes" ; then
			do64bit=amd64
			MACHINE="AMD64"
			{ $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
		fi
		;;
	esac
    else
	if test "${SHARED_BUILD}" = "0" ; then
	    # static
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
$as_echo "using static flags" >&6; }
	    runtime=-MT
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s.exe"
	else
	    # dynamic
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
$as_echo "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"







|
|



|
|










|






|
>

|



|

|
|
|
|






|
|





|
|







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
4313
4314
4315
4316
4317
4318
4319
4320
4321
		amd64|x64|yes)
		    MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
		    ;;
		ia64)
		    MACHINE="IA64"
		    ;;
	    esac
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   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"







|
|







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
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
	else
	    LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
	    LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
	fi
    fi

    if test "$do64bit" != "no" ; then
	$as_echo "#define TCL_CFG_DO64BIT 1" >>confdefs.h

    fi

    if test "${GCC}" = "yes" ; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5
$as_echo_n "checking for SEH support in compiler... " >&6; }
if ${tcl_cv_seh+:} false; then :

  $as_echo_n "(cached) " >&6
else
  if test "$cross_compiling" = yes; then :

  tcl_cv_seh=no
else











































  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
  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5
$as_echo "$tcl_cv_seh" >&6; }
	if test "$tcl_cv_seh" = "no" ; then

$as_echo "#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.
	#
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5
$as_echo_n "checking for EXCEPTION_DISPOSITION support in include files... " >&6; }
if ${tcl_cv_eh_disposition+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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 ()
{

		EXCEPTION_DISPOSITION x;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_eh_disposition=yes
else
  tcl_cv_eh_disposition=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5
$as_echo "$tcl_cv_eh_disposition" >&6; }
	if test "$tcl_cv_eh_disposition" = "no" ; then

$as_echo "#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.

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5
$as_echo_n "checking for winnt.h that ignores VOID define... " >&6; }
if ${tcl_cv_winnt_ignore_void+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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 ()
{

		CHAR c;
		SHORT s;
		LONG l;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_winnt_ignore_void=yes
else
  tcl_cv_winnt_ignore_void=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5
$as_echo "$tcl_cv_winnt_ignore_void" >&6; }
	if test "$tcl_cv_winnt_ignore_void" = "yes" ; then

$as_echo "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h

	fi

	ac_fn_c_check_header_mongrel "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default"
if test "x$ac_cv_header_stdbool_h" = xyes; then :


$as_echo "#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.

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5
$as_echo_n "checking for cast to union support... " >&6; }
if ${tcl_cv_cast_to_union+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
{

		  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
  tcl_cv_cast_to_union=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5
$as_echo "$tcl_cv_cast_to_union" >&6; }
	if test "$tcl_cv_cast_to_union" = "yes"; then

$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h

	fi
    fi

    # DL_LIBS is empty, but then we match the Unix version







# Cross-compiling







|




|
|
|
>
|
|
|
>

|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|


















|
>

|








|
|


|









|
|
|
>
|
|








|








|
>

|


|


|
|


|







|
|
|
>
|
|









|










|
>

|


|


|
|


|



|
|
>

|




<




|
|
|
>
|
|




|









|
>

|


|


|
|


|





>







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
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

#------------------------------------------------------------------------
#	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

  tcl_ok=yes

fi
if test "$tcl_ok" = "yes"; then :


  ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}

  TOMMATH_DLL_FILE=\${TOMMATH_DLL_FILE}


$as_echo "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h

  if test "$do64bit" != "no"; then :



$as_echo "#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

      ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib

      TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/tommath.lib


fi

else

    ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib

    TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win32/tommath.lib


fi

else

  ZLIB_OBJS=\${ZLIB_OBJS}

  TOMMATH_OBJS=\${TOMMATH_OBJS}


fi

$as_echo "#define HAVE_ZLIB 1" >>confdefs.h


ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default"
if test "x$ac_cv_type_intptr_t" = xyes; then :


$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h

else

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size signed integer type" >&5
$as_echo_n "checking for pointer-size signed integer type... " >&6; }
if ${tcl_cv_intptr_t+:} false; then :
  $as_echo_n "(cached) " >&6
else

    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))];
test_array [0] = 0;
return test_array [0];

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_ok=yes
else
  tcl_ok=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	    test "$tcl_ok" = yes && break; fi
    done
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intptr_t" >&5
$as_echo "$tcl_cv_intptr_t" >&6; }
    if test "$tcl_cv_intptr_t" != none; then

cat >>confdefs.h <<_ACEOF
#define intptr_t $tcl_cv_intptr_t
_ACEOF

    fi

fi


ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default"
if test "x$ac_cv_type_uintptr_t" = xyes; then :


$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h

else

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size unsigned integer type" >&5
$as_echo_n "checking for pointer-size unsigned integer type... " >&6; }
if ${tcl_cv_uintptr_t+:} false; then :
  $as_echo_n "(cached) " >&6
else

    for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
	    none; do
	if test "$tcl_cv_uintptr_t" != none; then
	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))];
test_array [0] = 0;
return test_array [0];

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_ok=yes
else
  tcl_ok=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	    test "$tcl_ok" = yes && break; fi
    done
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_uintptr_t" >&5
$as_echo "$tcl_cv_uintptr_t" >&6; }
    if test "$tcl_cv_uintptr_t" != none; then

cat >>confdefs.h <<_ACEOF
#define uintptr_t $tcl_cv_uintptr_t
_ACEOF

    fi

fi



#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
# Check whether --enable-zipfs was given.
if test "${enable_zipfs+set}" = set; then :

  enableval=$enable_zipfs; tcl_ok=$enableval
else
  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
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
$as_echo_n "checking for gcc... " >&6; }
    if ${ac_cv_path_cc+:} false; then :

  $as_echo_n "(cached) " >&6
else

	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







|
>




|




|
>






|

|
>


|

|
>






|








|








|








|


|
<
|

<
|
<
|
<
<
<
<
<
|
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<

<
<
<

>
|
<
|

<
|
<
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|
<
<
<
|
|
<
|
<
<
<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






|
>

|












|
|
|
>
|
|







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
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

# 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'
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
$as_echo_n "checking for build system executable suffix... " >&6; }
if ${bfd_cv_build_exeext+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
$as_echo "$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
    #

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
$as_echo_n "checking for tclsh... " >&6; }

    if ${ac_cv_path_tclsh+:} false; then :

  $as_echo_n "(cached) " >&6
else

	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"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
$as_echo "$TCLSH_PROG" >&6; }
    else
	# It is not an error if an installed version of Tcl can't be located.
	TCLSH_PROG=""
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
$as_echo "No tclsh found on PATH" >&6; }
    fi



    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
$as_echo_n "checking for zip... " >&6; }
    if ${ac_cv_path_zip+:} false; then :

  $as_echo_n "(cached) " >&6
else

    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"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
$as_echo "$ZIP_PROG" >&6; }
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="*"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
$as_echo "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}"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5
$as_echo "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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
$as_echo_n "checking for building with zipfs... " >&6; }
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;

$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h

       INSTALL_LIBRARIES=install-libraries-zipfs-static
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
     else

$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared

       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
    fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "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.

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
$as_echo_n "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; }
if ${tcl_cv_findex_enums+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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 ()
{

  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
  tcl_cv_findex_enums=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
$as_echo "$tcl_cv_findex_enums" >&6; }
if test "$tcl_cv_findex_enums" = "no"; then

$as_echo "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h

fi

# See if the compiler supports intrinsics.

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for intrinsics support in compiler" >&5
$as_echo_n "checking for intrinsics support in compiler... " >&6; }
if ${tcl_cv_intrinsics+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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 ()
{

  __cpuidex(0,0,0);

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :

  tcl_cv_intrinsics=yes
else
  tcl_cv_intrinsics=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intrinsics" >&5
$as_echo "$tcl_cv_intrinsics" >&6; }
if test "$tcl_cv_intrinsics" = "yes"; then

$as_echo "#define HAVE_INTRIN_H 1" >>confdefs.h

fi

# See if the <wspiapi.h> header file is present

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for wspiapi.h" >&5
$as_echo_n "checking for wspiapi.h... " >&6; }
if ${tcl_cv_wspiapi_h+:} false; then :

  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#include <wspiapi.h>

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  tcl_cv_wspiapi_h=yes
else
  tcl_cv_wspiapi_h=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_wspiapi_h" >&5
$as_echo "$tcl_cv_wspiapi_h" >&6; }
if test "$tcl_cv_wspiapi_h" = "yes"; then

$as_echo "#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.

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
$as_echo_n "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; }
if ${tcl_cv_findex_enums+:} false; then :

  $as_echo_n "(cached) " >&6
else
  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 ()
{

  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
  tcl_cv_findex_enums=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
$as_echo "$tcl_cv_findex_enums" >&6; }
if test "$tcl_cv_findex_enums" = "no"; then

$as_echo "#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.
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5
$as_echo_n "checking for build with symbols... " >&6; }
    # Check whether --enable-symbols was given.
if test "${enable_symbols+set}" = set; then :

  enableval=$enable_symbols; tcl_ok=$enableval
else
  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)'

$as_echo "#define NDEBUG 1" >>confdefs.h

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }

	$as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h

    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	if test "$tcl_ok" = "yes"; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5
$as_echo "yes (standard debugging)" >&6; }
	fi
    fi



    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then

$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h

    fi

    if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then

$as_echo "#define TCL_COMPILE_DEBUG 1" >>confdefs.h


$as_echo "#define TCL_COMPILE_STATS 1" >>confdefs.h

    fi

    if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
	if test "$tcl_ok" = "all"; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5
$as_echo "enabled symbols mem compile debugging" >&6; }
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5
$as_echo "enabled $tcl_ok debugging" >&6; }
	fi
    fi


#--------------------------------------------------------------------
# Embed the manifest if we can determine how
#--------------------------------------------------------------------





















































































































































































































































































    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5
$as_echo_n "checking whether to embed manifest... " >&6; }
    # Check whether --enable-embedded-manifest was given.
if test "${enable_embedded_manifest+set}" = set; then :

  enableval=$enable_embedded_manifest; embed_ok=$enableval
else
  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 -f conftest*

    fi
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $result" >&5
$as_echo "$result" >&6; }




#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------







|
|
|
>
|
|













|
|








|
|

|
>
|
|



















|
|



|
|









|
|
|
>
|
|


















|
|


|
|








|
|







|





|
|




|

<
<
<


|

<
>
|
|
<

|
|

















|
|
|
>
|
|








|









|
>

|


|


|
|


|





|
|
|
>
|
|









|








|
>

|


|



|
|


|





|
|
|
>
|
|






|






|
>

|


|


|
|


|







|
|
|
>
|
|








|









|
>

|


|


|
|


|










|
|

|
>

|








|

|
|

|





|
|







|





|


|





|
|

|
|








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|

|
>

|



















|
>















|


|
|







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
5277
5278
5279
5280
5281
5282
5283
5284
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 ; 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}\""








|







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
5427
5428
5429
5430
5431
5432
5433
5434







ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj 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.







|







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
5456
5457
5458
5459
5460
5461
5462
5463
5464
# 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_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$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







|
|







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
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
    esac |
    sort
) |
  sed '
     /^ac_cv_env_/b end
     t clear
     :clear
     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
     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
      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
$as_echo "$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
    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
$as_echo "$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}'







|






|
|













|
|







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
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

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=`$as_echo "$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"
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
$as_echo "$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.







|















|
|







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

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
cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##

# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh

if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :

  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac
fi










as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '


    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi

  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'









fi





# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; 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


# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

# 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

  test -z "$as_dir" && as_dir=.



    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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH


# 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
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$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 ()
{







>
|
>






|









>
>
>
>
>
>
>
>



<
<
<
<
<
<
<
<
|
|
<
|
|
<
<
<
<
<
<
|
<
<
<
<
<
<
<
|
>
>
|
<
<
>
|
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>


|








<
<
<
<
<
<
<








>
|
>
>
>
|











|



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












|

|


>







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
5771

5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788

5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
# ---------------
# 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_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_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith









>






|
>




|











|
>




|







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
5824
5825
5826
5827
5828
5829
5830
5831
  as_dirname=false
fi

as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
	    s//\1/
	    q







|







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
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
  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=`$as_echo "$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 ||
$as_echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q







|








|







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
5971
5972
5973
5974
5975
5976
5977
5978
5979
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 $as_me, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@








|
|







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
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035

Configuration files:
$config_files

Report bugs to the package provider."

_ACEOF


cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
config.status
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 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







>
>

|

|
|


|







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
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
  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 )
    $as_echo "$ac_cs_version"; exit ;;
  --config | --confi | --conf | --con | --co | --c )
    $as_echo "$ac_cs_config"; exit ;;
  --debug | --debu | --deb | --de | --d | -d )
    debug=: ;;
  --file | --fil | --fi | --f )
    $ac_shift
    case $ac_optarg in
    *\'*) ac_optarg=`$as_echo "$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 )
    $as_echo "$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." ;;







|

|





|





|







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
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
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
  \$as_echo "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
  $as_echo "$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" ;;
    "tcl.hpj") CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
    "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+set}" = set || 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:







|













|














<












|







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
6377
6378
6379
6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
	 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=`$as_echo "$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 '`
	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
	`' by configure.'
    if test x"$ac_file" != x-; then
      configure_input="$ac_file.  $configure_input"
      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
$as_echo "$as_me: creating $ac_file" >&6;}
    fi
    # Neutralize special characters interpreted by sed in replacement strings.
    case $configure_input in #(
    *\&* | *\|* | *\\* )
       ac_sed_conf_input=`$as_echo "$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 ||
$as_echo X"$ac_file" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q







|







|



|
|




|
















|







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
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
	  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=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$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







|

|







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
6491
6492
6493
6494
6495
6496
6497
6498
6499
/@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@*)
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
$as_echo "$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







|
|







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
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
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"; } &&
  { $as_echo "$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
$as_echo "$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 \







|

|







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
6583
6584
6585
6586
6587

  $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
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi










|
|



>
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

6
7
8
9
10
11
12
13
14
#! /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(../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





>
|
|







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
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_HEADER_STDC

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.







<







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
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
  ])
], [
  AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
  AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}])
])
AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])

AC_CHECK_TYPE([intptr_t], [
    AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_intptr_t" != none; then
	AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
	   type wide enough to hold a pointer.])
    fi
])
AC_CHECK_TYPE([uintptr_t], [
    AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [
    for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
	    none; do
	if test "$tcl_cv_uintptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_uintptr_t" != none; then
	AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
	   type wide enough to hold a pointer.])
    fi
])


#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
AC_ARG_ENABLE(zipfs,
    AC_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?])
       INSTALL_LIBRARIES=install-libraries-zipfs-static
       AC_MSG_RESULT([yes])
     else
       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       AC_MSG_RESULT([yes])
    fi

else
AC_MSG_RESULT([no])
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi
AC_SUBST(ZIPFS_BUILD)
AC_SUBST(TCL_ZIP_FILE)







|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<





|













|










<
<


<
<

>







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
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

# 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_TRY_COMPILE([
#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_TRY_LINK([
#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_TRY_COMPILE([
#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_TRY_COMPILE([
#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

#--------------------------------------------------------------------







|



|
<


|
|
|










|




|
<

|
|
|










|

|
|
|












|



|
<


|
|
|







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
348
349
350
351
352
353
354
355
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 ; 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}\""








|







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
498

499
500
501
502
AC_SUBST(RC_OUT)
AC_SUBST(RC_TYPE)
AC_SUBST(RC_INCLUDE)
AC_SUBST(RC_DEFINE)
AC_SUBST(RC_DEFINES)
AC_SUBST(RES)

AC_OUTPUT(Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest)


dnl Local Variables:
dnl mode: autoconf;
dnl End:







|
>


|

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
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/trunk/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)].







|







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
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
#
# 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=msvcrt,nothreads,pdbs,profile,static,staticpkg,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.
#





#		msvcrt    = Affects the static option only to switch it from
#			    using libcmt(d) as the C runtime [by default] to
#			    msvcrt(d). This is useful for static embedding
#			    support.

#		nothreads = Turns off full multithreading support (default on).
#		pbds      =  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), as well.
#		staticpkg = Affects the static option only to switch
#			    tclshXX.exe to have the dde and reg extension linked
#			    inside it.
#		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







|




>
>
>
>
>
|
|
|

>

|
|

|
<
|
<
|







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
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
!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\reg\pkgIndex.tcl registry >> versions.vc]
!endif

!include versions.vc

DDEDOTVERSION = 1.4
DDEVERSION = $(DDEDOTVERSION:.=)

REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)

TCLREGLIBNAME	= $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB	= $(OUT_DIR)\$(TCLREGLIBNAME)

TCLDDELIBNAME	= $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB	= $(OUT_DIR)\$(TCLDDELIBNAME)

TCLTEST		= $(OUT_DIR)\$(PROJECT)test.exe

TCLSHOBJS = \
	$(TMP_DIR)\tclAppInit.obj \
!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
	$(TMP_DIR)\tclWinReg.obj \
	$(TMP_DIR)\tclWinDde.obj \
!endif
!endif
	$(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)
!if $(TCL_USE_STATIC_PACKAGES)
	$(TMP_DIR)\tclWinReg.obj \
	$(TMP_DIR)\tclWinDde.obj \
!endif
	$(OUT_DIR)\tommath.lib \
!endif
	$(TMP_DIR)\testMain.obj

COREOBJS = \
	$(TMP_DIR)\regcomp.obj \
	$(TMP_DIR)\regerror.obj \







|










|


|






<
<
<
<
<
<









<
<
<
<







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
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
!endif


#---------------------------------------------------------------------
# Project specific targets
#---------------------------------------------------------------------

release:    setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
core:	    setup $(TCLLIB) $(TCLSTUBLIB)
shell:	    setup $(TCLSH)
dlls:	    setup $(TCLREGLIB) $(TCLDDELIB) $(OUT_DIR)\zlib1.dll $(OUT_DIR)\libtommath.dll

all:	    setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs









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.3 [list load "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.5 [list load "$(TCLREGLIB:\=/)" registry]
<<

runtest: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)

runshell: setup $(TCLSH) dlls







|



>
|
>
>
>
>
>
>
>
>
>











|
|







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
595
596
597
598
599
600
601
602
!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.







<







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
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

#---------------------------------------------------------------------
# Special case object file targets
#---------------------------------------------------------------------

$(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c
	$(cc32) $(appcflags) /DTCL_TEST /DUNICODE /D_UNICODE \
	    /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -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$@ $?














$(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="\"$(CFG_RUNTIME_DLLFILE:\=\\)\""     \
	/DCFG_RUNTIME_ZIPFILE="\"$(CFG_RUNTIME_ZIPFILE:\=\\)\""     \
	-Fo$@ $?

$(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c
	$(cc32) $(appcflags) /DUNICODE /D_UNICODE \
	    /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -Fo$@ $?

### The following objects should be built using the stub interfaces

$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c
	$(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?


$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
	$(cc32) $(appcflags) /DUSE_TCL_STUBS -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)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
	$(cc32) $(stubscflags) -Fo$@ $?

$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
	$(cc32) $(stubscflags) -Fo$@ $?








<
















>
|
>




>
>
>
>
>
>
>
>
>
>
>
>
>












|
<




<





|



|








>
>
>
>
>
>
>
>
>







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
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
	    "$(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)
!if $(STATIC_BUILD)
!if !$(TCL_USE_STATIC_PACKAGES)
	@$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\"
!endif
!else
	@$(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)
!if !$(TCL_USE_STATIC_PACKAGES)
	@$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\"
!endif
!else
	@$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
	@$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \
	    "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
!endif

	@echo Installing encodings
	@$(CPY) "$(ROOT)\library\encoding\*.enc" \
		"$(SCRIPT_INSTALL_DIR)\encoding\"

# "emacs font-lock highlighting fix

install-tzdata:

	@echo Installing time zone data
	@set TCL_LIBRARY=$(ROOT:\=/)/library
	@$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
	    "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"


install-msgs:

	@echo Installing message catalogs
	@set TCL_LIBRARY=$(ROOT:\=/)/library
	@$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
	    "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"


install-pdbs:
	@echo Installing debug symbols
	@$(CPY) "$(OUT_DIR)\*.pdb" "$(BIN_INSTALL_DIR)\"
# "emacs font-lock highlighting fix

#---------------------------------------------------------------------







>

|
<
<
<
<





|
<
<
<
<
|
|
|

>



>



>




>


>




>







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
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
#include <stdio.h>
#include <math.h>

/*
 * This library is required for x64 builds with _some_ versions of MSVC
 */
#if defined(_M_IA64) || defined(_M_AMD64)
#if _MSC_VER >= 1400 && _MSC_VER < 1500
#pragma comment(lib, "bufferoverflowU")
#endif
#endif

/* ISO hack for dumb VC++ */
#ifdef _MSC_VER
#define   snprintf	_snprintf
#endif


/* protos */







<
<
<
<
<
<
<
<
<







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
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 "nmakehlp.c" -link -subsystem:console > nul]
!endif

# First locate the Tcl directory that we are working with.
!if "$(TCLDIR)" != ""

_RULESDIR = $(TCLDIR:/=\)








|







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
9
10
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/trunk/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 = 6

# 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)" == ""








|

















|







1
2
3
4
5
6
7
8
9
10
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
656
657
658
659
660
661
662
663
664
665
666
667
668
669

670
671
672
673
674
675
676
677
678
679
# 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. 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)

# TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions
#           in the Tcl shell. 0 -> keep them as shared libraries
#           Does not impact shared Tcl builds.
# 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)







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|













>

|
|







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
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
!if [nmakehlp -f $(OPTS) "nomsvcrt"]
!message *** Doing nomsvcrt
MSVCRT		= 0
!else
!if [nmakehlp -f $(OPTS) "msvcrt"]
!message *** Doing msvcrt
!else
!if $(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







|
















|







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
839
840
841
842
843
844
845
846
MSG=^
This compiler does not support profile guided optimization.
!error $(MSG)
!endif
!endif

################################################################
# 7. 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







|







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
869
870
871
872
873
874
875
876
!else
TCL_COMPILE_DEBUG   = 0
!endif

!endif

####################################################################
# 8. 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







|







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
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
!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
!message *** Doing 64bit portability warnings
WARNINGS		    = $(WARNINGS) -Wp64
!endif

!endif

################################################################
# 9. Extract various version numbers
# 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_PATCH_LEVEL
# TCL_VERSION
# TK_MAJOR_VERSION
# TK_MINOR_VERSION
# TK_PATCH_LEVEL
# 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_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_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 defined(_TK_H)
TK_VERSION	= $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
TK_DOTVERSION	= $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
!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

################################################################
# 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.,
#







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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

1091



1092

1093
1094
1095
1096
1097

1098
1099
1100
1101
1102
1103
1104
!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

!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)


TCLSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
TCLSTUBLIB	= $(OUT_DIR)\$(TCLSTUBLIBNAME)
TCL_INCLUDES    = -I"$(WIN_DIR)" -I"$(GENERICDIR)"

!else # !$(DOING_TCL)








>

>
|
>
>
>

>





>







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
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
!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
TKLIBNAME	= $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)


TKSTUBLIBNAME	= tkstub$(TK_VERSION).lib
TKIMPLIBNAME	= tk$(TK_VERSION)$(SUFX).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)"


!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"


!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"


!endif # TKINSTALL

tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"

!endif # $(DOING_TK)
!endif # $(DOING_TK) || $(NEED_TK)

# Various output paths
PRJIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
PRJLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)






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.







|
>
>
|

>
>
>
>
>






|
>














>
>

>










>
>

>







|
>
>
>
>
>
>







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
1289
1290
1291
1292
1293
1294
1295
1296
# 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







|







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
1326
1327
1328
1329
1330
1331
1332
1333
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 /DUSE_TCLOO_STUBS
!if $(NEED_TK)
USE_STUBS_DEFS  = $(USE_STUBS_DEFS) /DUSE_TK_STUBS
!endif
!endif
!endif # USE_STUBS

!if !$(DEBUG)







|







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
1459
1460
1461
1462
1463
1464
1465
1466
# 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 /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS)

# Link flags

!if $(DEBUG)
ldebug	= -debug -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3







|







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
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
!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

# Old linkers (Visual C++ 6 in particular) will link for fast loading
# on Win98. Since we do not support Win98 any more, we specify nowin98
# as recommended for NT and later. However, this is only required by
# IX86 on older compilers and only needed if we are not doing a static build.

!if "$(MACHINE)" == "IX86" && !$(STATIC_BUILD)
!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)]
# Align sections for PE size savings.
lflags	= $(lflags) -opt:nowin98
!endif
!endif

dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows

# Libraries that are required for every image.







<
<
<
<
<
<
<
<
<
<
<
<







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
1553




1554
1555

1556
1557




1558
1559
1560
1561
1562
1563
1564
1565


1566
1567
1568
1569
1570
1571
1572
DEFAULT_BUILD_TARGET = $(PROJECT)
!endif

default-target: $(DEFAULT_BUILD_TARGET)

!if $(MULTIPLATFORM_INSTALL)
default-pkgindex:

	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
	    [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl




!else
default-pkgindex:

	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
	    [list load [file join $$dir $(PRJLIBNAME)]] > $(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)


<<

default-install: default-install-binaries default-install-libraries
!if $(SYMBOLS)
default-install: default-install-pdbs
!endif








>

|
>
>
>
>


>

|
>
>
>
>








>
>







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
1767
1768
1769
1770
1771
1772
1773
1774
1775
!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("$(OUT_DIR)\tcl.nmake")
TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake"
!endif
!endif # TCLINSTALL

!if $(CONFIG_CHECK)
!ifdef TCLNMAKECONFIG
!include $(TCLNMAKECONFIG)








|
|







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
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/trunk/tip/477.md) for docs.

$(PROJECT): setup pkgindex $(PRJLIB)

!ifdef PRJ_STUBOBJS
$(PROJECT): $(PRJSTUBLIB)
$(PRJSTUBLIB): $(PRJ_STUBOBJS)
	$(LIBCMD) $**






|







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
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 OPTS=none 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 OPTS=threads MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
# PROP Target_File "Release\tclsh90t.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ELSEIF  "$(CFG)" == "tcl - Win32 Debug"








|








|







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
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\StaticPkg.3
# End Source File
# Begin Source File

SOURCE=..\doc\StdChannels.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
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455

SOURCE=.\rmd.bat
# End Source File
# Begin Source File

SOURCE=.\rules.vc
# End Source File
# Begin Source File

SOURCE=.\tcl.hpj.in
# End Source File
# Begin Source File

SOURCE=.\tcl.m4
# End Source File
# Begin Source File

SOURCE=.\tcl.rc







<
<
<
<







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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
; This file is maintained by HCW. Do not modify this file directly.

[OPTIONS]
HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
CNT=tcl90.cnt
COPYRIGHT=Copyright � 2000 Ajuba Solutions
HLP=tcl90.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0

[CONFIG]
BrowseButtons()
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






































Changes to win/tcl.m4.

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,
	    AC_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 )







|

|







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
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,
	    AC_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 )







|

|







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
254
255
256
257
258
259
260
261
#
# Results:
#
#	Substitutes the following vars:
#		TCL_BIN_DIR
#		TCL_SRC_DIR
#		TCL_LIB_FILE
#		TCL_ZIP_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







<







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
291
292
293
294
295
296
297
298
    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_ZIP_FILE)
    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)







<







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
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
#------------------------------------------------------------------------

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 "${enable_shared+set}" = set; then
	enableval="$enable_shared"
	tcl_ok=$enableval
    else
	tcl_ok=yes
    fi

    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?])







<
<
<
<
<
<
<
<







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
520
521
522
523
524
525
526
527
528
529
530
531
532
533
    # 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_TRY_COMPILE([
	    #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"







|



|
|
|







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
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
    # 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_TRY_COMPILE([
		#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_TRY_LINK([
	#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




















    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"







|



|
|
|








|


|
<
|
|







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
685
686
687
688
689
690
691
692
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
		;;
	esac

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-o \[$]@"
	CC_EXENAME="-o \[$]@"








|







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
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
		AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
		;;
	    ia64)
		MACHINE="IA64"
		AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
		;;
	    *)
		AC_TRY_COMPILE([
		    #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])







|



|
|
|


|
|
|







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
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
    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_TRY_RUN([
	    #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_TRY_COMPILE([
#	    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_TRY_COMPILE([
		#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_TRY_COMPILE([],
	    [
		  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)

])

#------------------------------------------------------------------------
# SC_WITH_TCL --
#
#	Location of the Tcl build directory.
#







|














|
|
|
|














|



|

|
|
|












|




|



|
|
|














|
<


|
|
|












>







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
1110
1111
1112
1113
1114
1115
1116
1117
#		VC_MANIFEST_EMBED_EXE
#
#--------------------------------------------------------------------

AC_DEFUN([SC_EMBED_MANIFEST], [
    AC_MSG_CHECKING(whether to embed manifest)
    AC_ARG_ENABLE(embedded-manifest,
	AC_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" \







|







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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#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
extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */

#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES
extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
extern Tcl_PackageInitProc 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);







>
>
>
>


|
|


|
|
|
|







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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
Tcl_AppInit(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if ((Tcl_Init)(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES
    if (Registry_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);

    if (Dde_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
#endif

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(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) {







|



|




|






|







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
210
211
212
213
214
215
216
217
    /*
     * 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;
}

/*
 *-------------------------------------------------------------------------
 *







|







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
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
/*
 * tclWin32Dll.c --
 *
 *	This file contains the DLL entry point and other low-level bit bashing
 *	code that needs inline assembly.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 * Copyright (c) 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. */

/*
 * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it
 */

#if defined(_MSC_VER) && (_MSC_VER <= 1100) && defined (_M_IX86)
#define cpuid	__asm __emit 0fh __asm __emit 0a2h
#endif

/*
 * The following declaration is for the VC++ DLL entry point.
 */

BOOL APIENTRY		DllMain(HINSTANCE hInst, DWORD reason,
			    LPVOID reserved);







|
|


















<
<
<
<
<
<
<
<







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








27
28
29
30
31
32
33
/*
 * 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
188
189
190
191
192
193
194
195
196
197
198
199
200
    OSVERSIONINFOW os;

    hInstance = hInst;
    os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
    GetVersionExW(&os);

    /*
     * We no longer support Win32s or Win9x or Windows CE, 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 NT is the only supported platform");
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * TclWinNoBackslash --







|
|



|







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
7
8
9
10
11
12
13
14
/*
 * tclWinChan.c
 *
 *	Channel drivers for Windows channels based on files, command pipes and
 *	TCP sockets.
 *
 * 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 "tclWinInt.h"
#include "tclIO.h"






|







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
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 Tcl_WideInt	FileWideSeekProc(ClientData instanceData,
			    Tcl_WideInt 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,
			    Tcl_WideInt length);
static DWORD		FileGetType(HANDLE handle);
static int		NativeIsComPort(const WCHAR *nativeName);

/*
 * This structure describes the channel type structure for file based IO.
 */








|
|





|







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
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) {
	    TclWinConvertError(GetLastError());
	    errorCode = errno;
	}
    }

    /*
     * See if this FileInfo* is still on the thread local list.
     */







|







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
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 Tcl_WideInt
FileWideSeekProc(
    ClientData instanceData,	/* File state. */
    Tcl_WideInt 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;








|


|







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
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) {
	    TclWinConvertError(winError);
	    *errorCodePtr = errno;
	    return -1;
	}
    }
    return (((Tcl_WideInt)((unsigned)newPos))
	    | ((Tcl_WideInt)newPosHigh << 32));
}

/*
 *----------------------------------------------------------------------
 *
 * FileTruncateProc --
 *







|




|
|







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
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. */
    Tcl_WideInt 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) {
	    TclWinConvertError(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) {
	    TclWinConvertError(winError);
	    return errno;
	}
    }

    /*
     * Perform the truncation (unlike POSIX ftruncate(), we needed to move to
     * the location to truncate at first).
     */

    if (!SetEndOfFile(infoPtr->handle)) {
	TclWinConvertError(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.
     */







|














|















|










|







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
619
620
621
622
623
624
625
626
     */

    if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
	    (LPOVERLAPPED) NULL) != FALSE) {
	return bytesRead;
    }

    TclWinConvertError(GetLastError());
    *errorCode = errno;
    if (errno == EPIPE) {
	return 0;
    }
    return -1;
}








|







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
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) {
	TclWinConvertError(GetLastError());
	*errorCode = errno;
	return -1;
    }
    infoPtr->dirty = 1;
    return bytesWritten;
}








|







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
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) {
	    TclWinConvertError(GetLastError());
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't open serial \"%s\": %s",
			TclGetString(pathPtr), Tcl_PosixError(interp)));
	    }
	    return NULL;
	}







|







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
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;
	}
	TclWinConvertError(err);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't open \"%s\": %s",
		    TclGetString(pathPtr), Tcl_PosixError(interp)));
	}
	return NULL;
    }







|







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
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) {
	    TclWinConvertError(GetLastError());
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't reopen serial \"%s\": %s",
			TclGetString(pathPtr), Tcl_PosixError(interp)));
	    }
	    return NULL;
	}







|







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
7
8
9
10
11
12
13
14
/*
 * tclWinConsole.c --
 *
 *	This file implements the Windows-specific console functions, and the
 *	"console" channel driver.
 *
 * Copyright (c) 1999 by 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"







|







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
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) {
	    TclWinConvertError(GetLastError());
	    errorCode = errno;
	}
    }

    consolePtr->watchMask &= consolePtr->validMask;

    /*







|







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
775
776
777
778
779
780
781
782
    }

    /*
     * Check for a background error on the last write.
     */

    if (infoPtr->writeError) {
	TclWinConvertError(infoPtr->writeError);
	infoPtr->writeError = 0;
	goto error;
    }

    if (infoPtr->flags & CONSOLE_ASYNC) {
	/*
	 * The console is non-blocking, so copy the data into the output







|







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
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) {
	    TclWinConvertError(GetLastError());
	    goto error;
	}
    }
    return bytesWritten;

  error:
    *errorCode = errno;







|







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
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.
	     */

	    TclWinConvertError(GetLastError());

	    if (errno == EOF) {
		infoPtr->readFlags |= CONSOLE_EOF;
		return 1;
	    }

	    /*







|







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
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) {
	    TclWinConvertError(GetLastError());
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read console mode: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}







|







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
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) {
	    TclWinConvertError(GetLastError());
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't set console mode: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}







|







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
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) {
		TclWinConvertError(GetLastError());
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "couldn't read console mode: %s",
			    Tcl_PosixError(interp)));
		}
		return TCL_ERROR;
	    }







|







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
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)) {
	    TclWinConvertError(GetLastError());
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read console size: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}







|







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
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.3"
#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







|







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
7
8
9
10
11
12
13
14
/*
 * tclWinError.c --
 *
 *	This file contains code for converting from Win32 errors to errno
 *	errors.
 *
 * Copyright (c) 1995-1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
/*






|







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
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 */
};

/*
 *----------------------------------------------------------------------
 *
 * TclWinConvertError --
 *
 *	This routine converts a Win32 error into an errno value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the errno global variable.
 *
 *----------------------------------------------------------------------
 */

void
TclWinConvertError(
    int 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]);







|













|
|







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
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







|







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
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 (c) 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"







|







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
282
283
284
285
286
287
288
289
#endif
#endif

    if (retval != -1) {
	return retval;
    }

    TclWinConvertError(GetLastError());

    srcAttr = GetFileAttributesW(nativeSrc);
    dstAttr = GetFileAttributesW(nativeDst);
    if (srcAttr == 0xFFFFFFFF) {
	if (GetFullPathNameW(nativeSrc, 0, NULL,
		NULL) >= MAX_PATH) {
	    errno = ENAMETOOLONG;







|







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
423
424
425
426
427
428
429
430
		    }

		    /*
		     * Some new error has occurred. Don't know what it could
		     * be, but report this one.
		     */

		    TclWinConvertError(GetLastError());
		    CreateDirectoryW(nativeDst, NULL);
		    SetFileAttributesW(nativeDst, dstAttr);
		    if (Tcl_GetErrno() == EACCES) {
			/*
			 * Decode the EACCES to a more meaningful error.
			 */








|







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
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.
		     */

		    TclWinConvertError(GetLastError());
		    if (Tcl_GetErrno() == EACCES) {
			/*
			 * Decode the EACCES to a more meaningful error.
			 */

			goto decode;
		    }







|







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
672
673
674
675
676
677
678
679
#endif
#endif

    if (retval != -1) {
	return retval;
    }

    TclWinConvertError(GetLastError());
    if (Tcl_GetErrno() == EBADF) {
	Tcl_SetErrno(EACCES);
	return TCL_ERROR;
    }
    if (Tcl_GetErrno() == EACCES) {
	DWORD srcAttr, dstAttr;








|







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
709
710
711
712
713
714
715
716
		}

		/*
		 * Still can't copy onto dst. Return that error, and restore
		 * attributes of dst.
		 */

		TclWinConvertError(GetLastError());
		SetFileAttributesW(nativeDst, dstAttr);
	    }
	}
    }
    return TCL_ERROR;
}








|







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
769
770
771
772
773
774
775
776
	Tcl_SetErrno(ENOENT);
	return TCL_ERROR;
    }

    if (DeleteFileW(path) != FALSE) {
	return TCL_OK;
    }
    TclWinConvertError(GetLastError());

    if (Tcl_GetErrno() == EACCES) {
	attr = GetFileAttributesW(path);
	if (attr != 0xFFFFFFFF) {
	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
		if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
		    /*







|







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
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;
		}
		TclWinConvertError(GetLastError());
		if (res != 0) {
		    SetFileAttributesW(path, attr);
		}
	    }
	}
    } else if (Tcl_GetErrno() == ENOENT) {
	attr = GetFileAttributesW(path);







|







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
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();

	TclWinConvertError(error);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------







|







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
1057
1058
1059
1060
1061
1062
1063
1064
	 */

	if (RemoveDirectoryW(nativePath) != FALSE) {
	    return TCL_OK;
	}
    }

    TclWinConvertError(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







|







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
1091
1092
1093
1094
1095
1096
1097
1098
		if (SetFileAttributesW(nativePath,
			attr) == FALSE) {
		    goto end;
		}
		if (RemoveDirectoryW(nativePath) != FALSE) {
		    return TCL_OK;
		}
		TclWinConvertError(GetLastError());
		SetFileAttributesW(nativePath,
			attr | FILE_ATTRIBUTE_READONLY);
	    }
	}
    }

    if (Tcl_GetErrno() == ENOTEMPTY) {







|







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
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.
	 */

	TclWinConvertError(GetLastError());
	nativeErrfile = nativeSource;
	goto end;
    }

    Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
    Tcl_DStringSetLength(sourcePtr, oldSourceLen);
    result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED,







|







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
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) {
	TclWinConvertError(GetLastError());
	if (errorPtr != NULL) {
	    Tcl_DStringInit(errorPtr);
	    Tcl_WCharToUtfDString(nativeErrfile, -1, errorPtr);
	}
	result = TCL_ERROR;
    }








|







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
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;
	    }
	    TclWinConvertError(GetLastError());
	}
	break;
    case DOTREE_POSTD:
	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
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. */
{
    TclWinConvertError(GetLastError());
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
	    TclGetString(fileName), Tcl_PosixError(interp)));
}

/*
 *----------------------------------------------------------------------
 *







|







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
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 = TclGetStringFromObj(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] == '\\')) {







|







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
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 = TclGetStringFromObj(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.
	     */







|







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
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 = TclGetStringFromObj(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







|







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
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) {
	TclWinConvertError(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.







|







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
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 (c) 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"








|







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
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	\
	((Tcl_WideInt) 116444736 * (Tcl_WideInt) 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.
 */








|







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
212
213
214
215
216
217
218
219

    if (!GetFullPathNameW(linkTargetPath, MAX_PATH, tempFileName,
	    &tempFilePart)) {
	/*
	 * Invalid file.
	 */

	TclWinConvertError(GetLastError());
	return -1;
    }

    /*
     * Make sure source file doesn't exist.
     */








|







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
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

    if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName,
	    &tempFilePart)) {
	/*
	 * Invalid file.
	 */

	TclWinConvertError(GetLastError());
	return -1;
    }

    /*
     * Check the target.
     */

    attr = GetFileAttributesW(linkTargetPath);
    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * The target doesn't exist.
	 */

	TclWinConvertError(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;
	    }

	    TclWinConvertError(GetLastError());
	} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {


	    /*
	     * Can't symlink files.
	     */



	    Tcl_SetErrno(ENOTDIR);

	} else {
	    Tcl_SetErrno(ENODEV);
	}
    } else {
	/*
	 * We've got a directory. Now check whether what we're trying to do is
	 * reasonable.







|













|














|

>
>
|
|
|

>
>
|
>







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
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346

    if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName,
	    &tempFilePart)) {
	/*
	 * Invalid file.
	 */

	TclWinConvertError(GetLastError());
	return NULL;
    }

    /*
     * Make sure source file does exist.
     */

    attr = GetFileAttributesW(linkSourcePath);
    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * The source doesn't exist.
	 */

	TclWinConvertError(GetLastError());
	return NULL;

    } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
	/*
	 * It is a file - this is not yet supported.
	 */








|













|







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
500
501
502
503
504
505
506
507
    if (hFile != INVALID_HANDLE_VALUE) {
	if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
		REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) {
	    /*
	     * Error setting junction.
	     */

	    TclWinConvertError(GetLastError());
	    CloseHandle(hFile);
	} else {
	    CloseHandle(hFile);
	    if (!linkOnly) {
		RemoveDirectoryW(linkOrigPath);
	    }
	    return 0;







|







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
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
	    FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);

    if (hFile == INVALID_HANDLE_VALUE) {
	/*
	 * Error creating directory.
	 */

	TclWinConvertError(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.
	 */

	TclWinConvertError(GetLastError());
	CloseHandle(hFile);
	return -1;
    }
    CloseHandle(hFile);

    if (!IsReparseTagValid(buffer->ReparseTag)) {
	Tcl_SetErrno(EINVAL);







|













|







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
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
     */

    if (CreateDirectoryW(linkDirPath, NULL) == 0) {
	/*
	 * Error creating directory.
	 */

	TclWinConvertError(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.
	 */

	TclWinConvertError(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.
	 */

	TclWinConvertError(GetLastError());
	CloseHandle(hFile);
	RemoveDirectoryW(linkDirPath);
	return -1;
    }
    CloseHandle(hFile);

    /*







|










|














|







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
864
865
866
867
868
869
870
871
    const char *argv0)		/* If NULL, install PanicMessageBox, otherwise
				 * ignore. */
{
    WCHAR wName[MAX_PATH];
    char name[MAX_PATH * 3];
    (void)argv0;

    GetModuleFileNameW(NULL, wName, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
    TclWinNoBackslash(name);
    TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
}

/*
 *----------------------------------------------------------------------







|







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
920
921
922
923
924
925
926
927
	    /*
	     * Match a single file directly.
	     */

	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;
	    size_t length = 0;
	    const char *str = TclGetStringFromObj(norm, &length);

	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesExW(native,
		    GetFileExInfoStandard, &data) != TRUE) {
		return TCL_OK;
	    }







|







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
980
981
982
983
984
985
986
987

	/*
	 * Build up the directory name for searching, including a trailing
	 * directory separator.
	 */

	Tcl_DStringInit(&dsOrig);
	dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

	lastChar = dirName[dirLength -1];
	if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
	    TclDStringAppendLiteral(&dsOrig, "/");
	    dirLength++;
	}







|







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
1036
1037
1038
1039
1040
1041
1042
1043
		 * means we just return TCL_OK, indicating no results found.
		 */

		Tcl_DStringFree(&dsOrig);
		return TCL_OK;
	    }

	    TclWinConvertError(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;







|







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
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
		&& 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")) {
	/*







|




















|







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
1585
1586
1587
1588
1589
1590
1591
1592
    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * File might not exist.
	 */

	DWORD lasterror = GetLastError();
	if (lasterror != ERROR_SHARING_VIOLATION) {
	    TclWinConvertError(lasterror);
	    return -1;
	}
    }

    if (mode == F_OK) {
	/*
	 * File exists, nothing else to check.







|







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
1711
1712
1713
1714
1715
1716
1717
1718
	error = GetLastError();
	if (error != ERROR_INSUFFICIENT_BUFFER) {
	    /*
	     * Most likely case is ERROR_ACCESS_DENIED, which we will convert
	     * to EACCES - just what we want!
	     */

	    TclWinConvertError((DWORD) error);
	    return -1;
	}

	/*
	 * Now size contains the size of buffer needed.
	 */








|







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
1816
1817
1818
1819
1820
1821
1822
1823
		&genMap, &privSet, &privSetSize, &grantedAccess,
		&accessYesNo)) {
	    /*
	     * Unable to perform access check.
	     */

	accessError:
	    TclWinConvertError(GetLastError());
	    if (sdPtr != NULL) {
		HeapFree(GetProcessHeap(), 0, sdPtr);
	    }
	    if (hToken != NULL) {
		CloseHandle(hToken);
	    }
	    return -1;







|







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
1873
1874
1875
1876
1877
1878
1879
1880
	return 0;
    }

    path += len-3;
    if ((_wcsicmp(path, L"exe") == 0)
	    || (_wcsicmp(path, L"com") == 0)
	    || (_wcsicmp(path, L"cmd") == 0)
	    || (_wcsicmp(path, L"cmd") == 0)
	    || (_wcsicmp(path, L"bat") == 0)) {
	return 1;
    }
    return 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
1911
1912
1913
1914
1915
1916
1917
1918

    if (!nativePath) {
	return -1;
    }
    result = SetCurrentDirectoryW(nativePath);

    if (result == 0) {
	TclWinConvertError(GetLastError());
	return -1;
    }
    return 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
1950
1951
1952
1953
1954
1955
1956
1957
				 * name of current directory. */
{
    WCHAR buffer[MAX_PATH];
    char *p;
    WCHAR *native;

    if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
	TclWinConvertError(GetLastError());
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error getting working directory name: %s",
		    Tcl_PosixError(interp)));
	}
	return NULL;
    }







|







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
2081
2082
2083
2084
2085
2086
2087
2088
2089
        } 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 = ((Tcl_WideInt) data.nFileSizeLow) |
		(((Tcl_WideInt) 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.
	 */







|
|







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
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
	if (GetFileAttributesExW(nativePath,
		GetFileExInfoStandard, &data) != TRUE) {
	    HANDLE hFind;
	    WIN32_FIND_DATAW ffd;
	    DWORD lasterror = GetLastError();

	    if (lasterror != ERROR_SHARING_VIOLATION) {
		TclWinConvertError(lasterror);
		return -1;
		}
	    hFind = FindFirstFileW(nativePath, &ffd);
	    if (hFind == INVALID_HANDLE_VALUE) {
		TclWinConvertError(GetLastError());
		return -1;
	    }
	    memcpy(&data, &ffd, sizeof(data));
	    FindClose(hFind);
	}

	attr = data.dwFileAttributes;

	statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
		(((Tcl_WideInt) 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));







|




|








|
|







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
2292
2293
2294
2295
2296
2297
2298
2299
{
    LARGE_INTEGER convertedTime;

    convertedTime.LowPart = fileTime.dwLowDateTime;
    convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;

    return (__time64_t) ((convertedTime.QuadPart -
	    (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
}

/*
 *------------------------------------------------------------------------
 *
 * FromCTime --
 *







|







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
2349
2350
2351
2352
2353
2354
2355
2356
ClientData
TclpGetNativeCwd(
    ClientData clientData)
{
    WCHAR buffer[MAX_PATH];

    if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
	TclWinConvertError(GetLastError());
	return NULL;
    }

    if (clientData != NULL) {
	if (wcscmp((const WCHAR *) clientData, buffer) == 0) {
	    return clientData;
	}







|







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
2806
2807
2808
2809
2810
2811
2812
2813

	    Tcl_Obj *tmpPathPtr;
	    size_t length;

	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		    nextCheckpoint);
	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
	    path = TclGetStringFromObj(tmpPathPtr, &length);
	    Tcl_SetStringObj(pathPtr, path, length);
	    Tcl_DecrRefCount(tmpPathPtr);
	} else {
	    /*
	     * End of string was reached above.
	     */








|







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
2891
2892
2893
2894
2895
2896
2897
2898
    } 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 = TclGetStringFromObj(useThisCwd, &cwdLen);
	char drive_cur = path[0];

	if (drive_cur >= 'a') {
	    drive_cur -= ('a' - 'A');
	}
	if (drive[0] == drive_cur) {
	    absolutePath = Tcl_DuplicateObj(useThisCwd);







|







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
3064
3065
3066
3067
3068
3069
3070
3071
	 * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl,
	 * so incr refCount here
	 */

	Tcl_IncrRefCount(validPathPtr);
    }

    str = TclGetStringFromObj(validPathPtr, &len);

    if (strlen(str) != len) {
	/*
	 * String contains NUL-bytes. This is invalid.
	 */

	goto done;







|







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
3100

3101
3102
3103
3104
3105
3106
3107
     */

    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 + 1);


    /*
     * 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] == '/')







|
>







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
3248
3249
3250
3251
3252
3253
3254
3255
     */

    fileHandle = CreateFileW(native, FILE_WRITE_ATTRIBUTES, 0, NULL,
	    OPEN_EXISTING, flags, NULL);

    if (fileHandle == INVALID_HANDLE_VALUE ||
	    !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
	TclWinConvertError(GetLastError());
	res = -1;
    }
    if (fileHandle != INVALID_HANDLE_VALUE) {
	CloseHandle(fileHandle);
    }
    return res;
}







|







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
6
7
8
9
10
11
12
13
14
/*
 * tclWinInit.c --
 *
 *	Contains the Windows-specific interpreter initialization functions.
 *
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by 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"





|
|







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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
#define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64	10
#endif
#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
#define PROCESSOR_ARCHITECTURE_UNKNOWN		0xFFFF
#endif


/*
 * Windows version dependend functions
 */
TclWinProcs tclWinProcs;

/*
 * The following arrays contain the human readable strings for the
 * processor values.
 */

#define NUMPROCESSORS 11
static const char *const processors[NUMPROCESSORS] = {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
};

/*
 * The default directory in which the init.tcl file is expected to be found.
 */

static TclInitProcessGlobalValueProc	InitializeDefaultLibraryDir;







<
<
<
<
<





|


|







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
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
 */

void
TclpInitPlatform(void)
{
    WSADATA wsaData;
    WORD wVersionRequested = MAKEWORD(2, 2);
    HMODULE handle;

    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

    /*
     * Fill available functions depending on windows version
     */
    handle = GetModuleHandleW(L"KERNEL32");
    tclWinProcs.cancelSynchronousIo =
	    (BOOL (WINAPI *)(HANDLE))(void *)GetProcAddress(handle,
	    "CancelSynchronousIo");
}

/*
 *-------------------------------------------------------------------------
 *
 * TclpInitLibraryPath --
 *







<


















<
<
<
<
<
<
<
<







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
226
227
228
229
230
231
232
233
     * Look for the library in its source checkout location.
     */

    Tcl_ListObjAppendElement(NULL, pathPtr,
	    TclGetProcessGlobalValue(&sourceLibraryDir));

    *encodingPtr = NULL;
    bytes = TclGetStringFromObj(pathPtr, &length);
    *lengthPtr = length++;
    *valuePtr = (char *)Tcl_Alloc(length);
    memcpy(*valuePtr, bytes, length);
    Tcl_DecrRefCount(pathPtr);
}

/*







|







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
351
352
353
354
355
356
357
358
359
    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, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);

    end = strrchr(name, '\\');
    *end = '\0';
    p = strrchr(name, '\\');
    if (p != NULL) {
	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
399
400
401
402
403
404
405
406
407
    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, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);

    end = strrchr(name, '\\');
    *end = '\0';
    p = strrchr(name, '\\');
    if (p != NULL) {
	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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
	    struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
    void *ebp;
    void *esp;
    int status;
} TCLEXCEPTION_REGISTRATION;
#endif

/*
 * Windows version dependend functions
 */
typedef struct TclWinProcs {
    BOOL (WINAPI *cancelSynchronousIo)(HANDLE);
} TclWinProcs;

MODULE_SCOPE TclWinProcs tclWinProcs;

/*
 * Declarations of functions that are not accessible by way of the
 * stubs table.
 */

MODULE_SCOPE char	TclWinDriveLetterForVolMountPoint(
			    const WCHAR *mountPoint);







<
<
<
<
<
<
<
<
<







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
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 (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 "tclWinInt.h"








|







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
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:
		TclWinConvertError(lastError);
		Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1);
	    }
	    Tcl_SetObjResult(interp, errMsg);
	}
	return TCL_ERROR;
    }








|







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
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
				 * that represents the loaded file. */
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;

    FreeLibrary(hInstance);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this function is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    TCL_UNUSED(const char *),
    TCL_UNUSED(Tcl_DString *))
{
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpTempFileNameForLibrary --
 *
 *	Constructs a temporary file name for loading a shared object (DLL).







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
410
411
412
413
414
415
416
417
	lastError = GetLastError();
	if (lastError != ERROR_ALREADY_EXISTS) {
	    break;
	}
	id *= 16777619;
    }

    TclWinConvertError(lastError);
    return TCL_ERROR;

    /*
     * Store our computed value in the global.
     */

  copyToGlobalBuffer:







|







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
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 (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"








|







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
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
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	TclpGlobalLock();
	if (!initialized) {
	    initialized = 1;
	    InitializeCriticalSection(&notifierMutex);
	}
	TclpGlobalUnlock();

	/*
	 * Register Notifier window class if this is the first thread to use
	 * this module.
	 */

	EnterCriticalSection(&notifierMutex);
	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("Unable to register TclNotifier window class");
	    }
	}
	notifierCount++;
	LeaveCriticalSection(&notifierMutex);

	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;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
 *	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
Tcl_FinalizeNotifier(
    ClientData clientData)	/* Pointer to notifier data. */
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
	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(&notifierMutex);
	if (notifierCount) {
	    notifierCount--;
	    if (notifierCount == 0) {
		UnregisterClassW(className, (HINSTANCE)TclWinGetTclInstance());
	    }
	}
	LeaveCriticalSection(&notifierMutex);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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 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
Tcl_AlertNotifier(
    ClientData clientData)	/* Pointer to thread data. */
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
	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);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimer --
 *
 *	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
Tcl_SetTimer(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.setTimerProc) {
	tclNotifierHooks.setTimerProc(timePtr);
	return;
    } else {
	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);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
 *
 *	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
Tcl_ServiceModeHook(
    int mode)			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    } else {
	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 --







|

<
<
<
|

|
|
|
|
|
|

|
|
|
|

|
|
|

|
|
|
|
|
|
|
|
|
|

|
>
|
|
|
|
|

|
|

|

|
|
|
|

|
<





|














|


<
<
<
<
|

|
|
|
|
|
|
|
|
|
|

|
|
|

|
|

|
|
|

|
|
|
|

|
|
|
|

|
|
|
|
|
|
|
|
|
|
<



|



















|


<
<
<
<
|

|
|
|
|
|

|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
<



|















|


<
<
<
<
|
|

|
|
|
|
|

|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
>
|
|
|
<
|
|
|
<






|














|



<
<
<
<
|

|
|
|
|
|
|
|
<
|

|
|
|
|

|
|
|
|
|
|

|
<







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(&notifierMutex);
    }
    TclpGlobalUnlock();

    /*
     * Register Notifier window class if this is the first thread to use this
     * module.
     */

    EnterCriticalSection(&notifierMutex);
    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(&notifierMutex);

    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(&notifierMutex);
    if (notifierCount) {
	notifierCount--;
	if (notifierCount == 0) {
	    UnregisterClassW(className, (HINSTANCE) TclWinGetTclInstance());
	}
    }
    LeaveCriticalSection(&notifierMutex);
}


/*
 *----------------------------------------------------------------------
 *
 * 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
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
    Tcl_ServiceAll();
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	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
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	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) {
		tclScaleTimeProcPtr(&myTime, tclTimeClientData);
	    }

	    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.
	     */

	again:

	    result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout,
		    QS_ALLINPUT, MWMO_ALERTABLE);
	    if (result == WAIT_IO_COMPLETION) {
		goto again;
	    } else 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 --
 *







|
















|


<
<
<
|
|
|
|

|
|
|

|
|
|
|
|

|

|
|

|
|
|

|
|
|
|

|
|
|
|
|

|
|
|
|
|
|

<
>


|
|
|
|
|
|
|

|
|
|

|
|
|
|

|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|

|
|
|
<







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
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
	desired.usec -= 1000000;
    }

    /*
     * TIP #233: Scale delay from virtual to real-time.
     */

    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
    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;

	tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
	sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|














|











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
6
7
8
9
10
11
12
13
 /*
 * tclWinPanic.c --
 *
 *	Contains the Windows-specific command-line panic proc.
 *
 * Copyright (c) 2013 by 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"





|







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
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 (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"







|







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
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:
	TclWinConvertError(ERROR_INVALID_FUNCTION);
	return NULL;
    }

    /*
     * Map the creation flags to the NT create mode.
     */








|







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
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;
	}
	TclWinConvertError(err);
	return NULL;
    }

    /*
     * Seek to the end of file if we are writing.
     */








|







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
722
723
724
725
726
727
728
729
     * Free the native representation of the contents if necessary.
     */

    if (contents != NULL) {
	Tcl_DStringFree(&dstring);
    }

    TclWinConvertError(GetLastError());
    CloseHandle(handle);
    DeleteFileW(name);
    return NULL;
}

/*
 *----------------------------------------------------------------------







|







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
787
788
789
790
791
792
793
794

    if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
	*readPipe = TclWinMakeFile(readHandle);
	*writePipe = TclWinMakeFile(writeHandle);
	return 1;
    }

    TclWinConvertError(GetLastError());
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCloseFile --







|







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
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) {
		TclWinConvertError(GetLastError());
		Tcl_Free(filePtr);
		return -1;
	    }
	}
	break;

    default:







|







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
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) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't duplicate input handle: %s",
		Tcl_PosixError(interp)));
	goto end;
    }

    if (outputHandle == 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
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) {
	TclWinConvertError(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) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't duplicate error handle: %s",
		Tcl_PosixError(interp)));
	goto end;
    }

    /*







|



















|







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
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) {
	TclWinConvertError(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.







|







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
1390
1391
1392
1393
1394
1395
1396
1397
	    applType = APPL_DOS;
	}
	break;
    }
    Tcl_DStringFree(&nameBuf);

    if (applType == APPL_NONE) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
		originalName, Tcl_PosixError(interp)));
	return APPL_NONE;
    }

    if (applType == APPL_WIN3X) {
	/*







|







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
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)) {
	TclWinConvertError(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);







|







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
2227
2228
2229
2230
2231
2232
2233
2234
	/*
	 * Ignore errors if we have data to return.
	 */

	return bytesRead;
    }

    TclWinConvertError(GetLastError());
    if (errno == EPIPE) {
	infoPtr->readFlags |= PIPE_EOF;
	return 0;
    }
    *errorCode = errno;
    return -1;
}







|







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
2286
2287
2288
2289
2290
2291
2292
2293
    }

    /*
     * Check for a background error on the last write.
     */

    if (infoPtr->writeError) {
	TclWinConvertError(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







|







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
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) {
	    TclWinConvertError(GetLastError());
	    goto error;
	}
    }
    return bytesWritten;

  error:
    *errorCode = errno;







|







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
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) {
	    TclWinConvertError(GetLastError());

	    /*
	     * Check to see if the peek failed because of EOF.
	     */

	    if (errno == EPIPE) {
		infoPtr->readFlags |= PIPE_EOF;







|







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
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 = TclGetStringFromObj(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 {







|







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
3264
3265
3266
3267
3268
3269
3270
3271
	TclDecrRefCount(tmpObj);
    }

    return Tcl_MakeFileChannel((ClientData) handle,
	    TCL_READABLE|TCL_WRITABLE);

  gotError:
    TclWinConvertError(GetLastError());
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPipeThreadCreateTI --







|







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
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587

	    SetEvent(evControl);

	    /*
	     * Cancel all sync-IO of this thread (may be blocked there).
	     */

	    if (tclWinProcs.cancelSynchronousIo) {
		tclWinProcs.cancelSynchronousIo(hThread);
	    }

	    /*
	     * Wait at most 20 milliseconds for the reader thread to close
	     * (regarding TIP#398-fast-exit).
	     */

	    /*







<
|
<







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
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 = 0x0501 means Windows XP and above
 */

#ifndef WINVER
#   define WINVER 0x0501
#endif
#ifndef _WIN32_WINNT
#   define _WIN32_WINNT 0x0501
#endif

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

/* Compatibility to older visual studio / windows platform SDK */







|



|


|







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
114
115
116
117
118
119
120
121
122
123
124
125
 * Need to block out these includes for building extensions with MetroWerks
 * compiler for Win32.
 */

#ifndef __MWERKS__
#include <sys/stat.h>
#include <sys/timeb.h>
#   ifdef __BORLANDC__
#	include <utime.h>
#   else
#	include <sys/utime.h>
#   endif /* __BORLANDC__ */
#endif /* __MWERKS__ */

/*
 * The following defines redefine the Windows Socket errors as
 * BSD errors so Tcl_PosixError can do the right thing.
 */








<
<
<
|
<







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
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
 * 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
#   if defined(_MSC_VER) && (_MSC_VER < 1600)
#	define hypot _hypot
#   endif
#   define exception _exception
#   undef EDEADLOCK
#   if defined(_MSC_VER) && (_MSC_VER >= 1700)
#	define timezone _timezone
#   endif
#endif /* _MSC_VER || __MSVCRT__ */

/*
 * Borland's timezone and environ functions.
 */

#ifdef  __BORLANDC__
#   define timezone _timezone
#   define environ  _environ
#endif /* __BORLANDC__ */

#ifdef __WATCOMC__
#   if !defined(__CHAR_SIGNED__)
#	error "You must use the -j switch to ensure char is signed."
#   endif
#endif


/*
 * MSVC 8.0 started to mark many standard C library functions depreciated
 * including the *printf family and others. Tell it to shut up.
 * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
 */
#if defined(_MSC_VER)
#   pragma warning(disable:4146)
#   pragma warning(disable:4244)
#if !defined(_WIN64)
#   pragma warning(disable:4305)
#endif
#   if _MSC_VER >= 1400
#	pragma warning(disable:4267)
#	pragma warning(disable:4996)
#   endif
#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.







<
<
<


|




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






<
|
|
<







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
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.5", NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Registry_Unload --
 *







|







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
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 (c) 1999 by 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]
 */







|







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
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) {
	    TclWinConvertError(GetLastError());
	    errorCode = errno;
	}
    }

    serialPtr->watchMask &= serialPtr->validMask;

    /*







|







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
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) {
	TclWinConvertError(GetLastError());
	*errorCode = errno;
	return -1;
    }
    return bytesRead;

  commError:
    infoPtr->lastError = infoPtr->error;







|







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
1013
1014
1015
1016
1017
1018
1019
1020
    }

    /*
     * Check for a background error on the last write.
     */

    if (infoPtr->writeError) {
	TclWinConvertError(infoPtr->writeError);
	infoPtr->writeError = 0;
	goto error1;
    }

    /*
     * Remember the number of bytes in output queue
     */







|







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
1072
1073
1074
1075
1076
1077
1078
1079
	    goto error;
	}
    }

    return (int) bytesWritten;

  writeError:
    TclWinConvertError(GetLastError());

  error:
    /*
     * Reset the output queue counter on error during blocking output
     */

    /*







|







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
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) {
		TclWinConvertError(GetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't setup comm buffers: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	infoPtr->sysBufRead  = inSize;







|







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
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) {
		TclWinConvertError(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) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't get comm state: %s", Tcl_PosixError(interp)));
    }
    return TCL_ERROR;

  setStateFailed:
    if (interp != NULL) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't set comm state: %s", Tcl_PosixError(interp)));
    }
    return TCL_ERROR;
}

/*







|
















|







|







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
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) {
		TclWinConvertError(GetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't get comm state: %s", Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}

	valid = 1;







|







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
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) {
		TclWinConvertError(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);







|







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
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) {
		TclWinConvertError(GetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't get tty status: %s", Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	valid = 1;
	SerialModemStatusStr(status, dsPtr);







|







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
6
7
8
9
10
11
12
13
/*
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * 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.
 *
 * -----------------------------------------------------------------------
 * The order and naming of functions in this file should minimize
 * the file diff to tclUnixSock.c.





|







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
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)) {
	    TclWinConvertError(error);
	    *errorCodePtr = Tcl_GetErrno();
	    bytesRead = -1;
	    break;
	}

	/*
	 * In the blocking case, wait until the file becomes readable or







|







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
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 {
	    TclWinConvertError(error);
	    *errorCodePtr = Tcl_GetErrno();
	    written = -1;
	    break;
	}

	/*
	 * In the blocking case, wait until the file becomes writable or







|







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
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) {
		TclWinConvertError((DWORD) WSAGetLastError());
		errorCode = Tcl_GetErrno();
	    }
	    Tcl_Free(thisfd);
	}
    }

    if (statePtr->addrlist != NULL) {







|







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
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)) {
	TclWinConvertError((DWORD) WSAGetLastError());
	readError = Tcl_GetErrno();
    }
    if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) {
	TclWinConvertError((DWORD) WSAGetLastError());
	writeError = Tcl_GetErrno();
    }
    return (readError != 0) ? readError : writeError;
}

/*
 *----------------------------------------------------------------------







|



|







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
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) {
	    TclWinConvertError(WSAGetLastError());
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't set socket option: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}







|







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
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) {
	    TclWinConvertError(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
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
1381
1382
1383
1384
1385
1386
1387
1388
		}

		/*
		 * Return error message.
		 */

		if (err) {
		    TclWinConvertError(err);
		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()),
                            -1);
		}
	    }
	}
	return TCL_OK;
    }







|







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
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) {
		TclWinConvertError((DWORD) WSAGetLastError());
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "can't get peername: %s",
			    Tcl_PosixError(interp)));
		}
		return TCL_ERROR;
	    }







|







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
1527
1528
1529
1530
1531
1532
1533
1534
	if (found) {
	    if (len) {
		return TCL_OK;
	    }
	    Tcl_DStringEndSublist(dsPtr);
	} else {
	    if (interp) {
		TclWinConvertError((DWORD) WSAGetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't get sockname: %s", Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
    }








|







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
1779
1780
1781
1782
1783
1784
1785
1786
	    SetEvent(tsdPtr->socketListLock);

	    /*
             * Continue on socket creation error.
             */

	    if (statePtr->sockets->fd == INVALID_SOCKET) {
		TclWinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * Win-NT has a misfeature that sockets are inherited in child
	     * processes by default. Turn off the inherit bit.
	     */







|







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
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) {
		TclWinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * For asynchroneous connect set the socket in nonblocking mode
	     * and activate connect notification
	     */







|







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
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();
	    TclWinConvertError(error);

	    if (async_connect && error == WSAEWOULDBLOCK) {
		/*
		 * Asynchroneous connect
		 *
		 * Remember that we jump back behind this next round
		 */







|







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
1907
1908
1909
1910
1911
1912
1913
1914

		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

		/*
                 * Get signaled connect error.
                 */

		TclWinConvertError((DWORD) statePtr->notifierConnectError);

		/*
                 * Clear eventual connect flag.
                 */

		CLEAR_BITS(statePtr->selectEvents, FD_CONNECT);








|







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
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) {
	    TclWinConvertError((DWORD) WSAGetLastError());
	    continue;
	}

	/*
	 * Win-NT has a misfeature that sockets are inherited in child
	 * processes by default. Turn off the inherit bit.
	 */







|







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
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) {
	    TclWinConvertError((DWORD) WSAGetLastError());
	    closesocket(sock);
	    continue;
	}
	if (port == 0 && chosenport == 0) {
	    address sockname;
	    socklen_t namelen = sizeof(sockname);








|







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
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) {
	    TclWinConvertError((DWORD) WSAGetLastError());
	    closesocket(sock);
	    continue;
	}

	if (statePtr == NULL) {
	    /*
	     * Add this socket to the global list of sockets.







|







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
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)) {
	    TclWinConvertError(GetLastError());
	    goto initFailure;
	}
    }

    /*
     * Check for per-thread initialization.
     */







|







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
6
7
8
9
10
11
12
13
/*
 * tclWinTest.c --
 *
 *	Contains commands for platform specific tests on Windows.
 *
 * 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.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS





|







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
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);
	TclWinConvertError(GetLastError());
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, volType, NULL);
    return TCL_OK;
#undef VOL_BUF_SIZE
}








|







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
6
7
8
9
10
11
12
13
14
15
/*
 * tclWinThread.c --
 *
 *	This file implements the Windows-specific thread operations.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation
 * Copyright (c) 2008 by 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"






|
|
|







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
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__) || defined(__BORLANDC__)
    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







|







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
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__) || defined(__BORLANDC__)
    _endthreadex((unsigned) status);
#else
    ExitThread((DWORD) status);
#endif
}

/*







|







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
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 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|







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
31

32
33
34
35
36
37
38

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. */







|
>







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
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
    LARGE_INTEGER posixEpoch;	/* Posix epoch expressed as 100-ns ticks since
				 * the windows epoch. */

    /*
     * Data used in developing the estimate of performance counter frequency
     */

    Tcl_WideUInt fileTimeSample[SAMPLES];
				/* Last 64 samples of system time. */
    Tcl_WideInt 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) (Tcl_WideInt) 0,
    (ULARGE_INTEGER) (DWORDLONG) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 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(Tcl_WideUInt fileTime,
			    Tcl_WideInt perfCounter, Tcl_WideInt perfFreq);
static Tcl_WideInt	AccumulateSample(Tcl_WideInt perfCounter,
			    Tcl_WideUInt fileTime);
static void		NativeScaleTime(Tcl_Time* timebuf,
			    ClientData clientData);
static Tcl_WideInt	NativeGetMicroseconds(void);
static void		NativeGetTime(Tcl_Time* timebuf,
			    ClientData clientData);

/*
 * TIP #233 (Virtualized Time): Data for the time hooks, if any.
 */

Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime;
Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime;
ClientData 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.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetSeconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;


    /* Try to use high resolution timer */

    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	return usecSincePosixEpoch / 1000000;
    } else {
	Tcl_Time t;

	tclGetTimeProcPtr(&t, tclTimeClientData);	/* Tcl_GetTime inlined. */
	return t.sec;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetClicks --







|

|













|

|
|
|


















|
>











|
|
|
|


|










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


















|


|

>
|
>
|
|
<




|
|







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
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetClicks(void)
{
    Tcl_WideInt usecSincePosixEpoch;


    /* Try to use high resolution timer */

    if ( tclGetTimeProcPtr == NativeGetTime
      && (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 */

	tclGetTimeProcPtr(&now, tclTimeClientData);	/* Tcl_GetTime inlined */

	return (Tcl_WideUInt)(now.sec * 1000000) + now.usec;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetWideClicks --







|


|

>
|
>
|
|
<
|








|
>
|







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
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
 *	This should be used for time-delta resp. for measurement purposes
 *	only, because on some platforms can return microseconds from some
 *	start time (not from the epoch).
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
TclpGetWideClicks(void)
{
    LARGE_INTEGER curCounter;

    if (!wideClick.initialized) {
	LARGE_INTEGER perfCounterFreq;

	/*
	 * The frequency of the performance counter is fixed at system boot and
	 * is consistent across all processors. Therefore, the frequency need
	 * only be queried upon application initialization.
	 */

	if (QueryPerformanceFrequency(&perfCounterFreq)) {
	    wideClick.perfCounter = 1;
	    wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart;
	} else {
	    /* fallback using microseconds */
	    wideClick.perfCounter = 0;
	    wideClick.microsecsScale = 1;
	}

	wideClick.initialized = 1;
    }
    if (wideClick.perfCounter) {
	if (QueryPerformanceCounter(&curCounter)) {
	    return (Tcl_WideInt)curCounter.QuadPart;
	}
	/* fallback using microseconds */
	wideClick.perfCounter = 0;
	wideClick.microsecsScale = 1;
	return TclpGetMicroseconds();
    } else {
    	return TclpGetMicroseconds();







|












>













|







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
285
286
287
288
289
290
291
292
 *----------------------------------------------------------------------
 */

double
TclpWideClickInMicrosec(void)
{
    if (!wideClick.initialized) {
    	(void)TclpGetWideClicks();	/* initialize */
    }
    return wideClick.microsecsScale;
}

/*
 *----------------------------------------------------------------------
 *







|







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
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
TclpGetMicroseconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;


    /* Try to use high resolution timer */

    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	return usecSincePosixEpoch;
    } else {
	/*
	* Use the Tcl_GetTime abstraction to get the time in microseconds, as
	* nearly as we can, and return it.
	*/

	Tcl_Time now;

	tclGetTimeProcPtr(&now, tclTimeClientData);	/* Tcl_GetTime inlined */
	return (((Tcl_WideInt)now.sec) * 1000000) + now.usec;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetTime --







|


|

>
|
>
|
|
<



|
|
|



|
|







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
356
357

358

359
360
361
362
363
364
365
366
367
368
369
370
371
372
 *----------------------------------------------------------------------
 */

void
Tcl_GetTime(
    Tcl_Time *timePtr)		/* Location to store time information. */
{
    Tcl_WideInt usecSincePosixEpoch;


    /* Try to use high resolution timer */

    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
	timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
    } else {
    	tclGetTimeProcPtr(timePtr, tclTimeClientData);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NativeScaleTime --







|

>
|
>
|
|
<



|







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
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
     * Native scale is 1:1. Nothing is done.
     */
}

/*
 *----------------------------------------------------------------------
 *


























































































 * NativeGetMicroseconds --
 *
 *	Gets the current system time in microseconds since the beginning
 *	of the epoch: 00:00 UCT, January 1, 1970.
 *
 * Results:
 *	Returns the wide integer with number of microseconds from the epoch, or
 *	0 if high resolution timer is not available.
 *
 * Side effects:
 *	On the first call, initializes a set of static variables to keep track
 *	of the base value of the performance counter, the corresponding wall
 *	clock (obtained through ftime) and the frequency of the performance
 *	counter. Also spins a thread whose function is to wake up periodically
 *	and monitor these values, adjusting them as necessary to correct for
 *	drift in the performance counter's oscillator.
 *
 *----------------------------------------------------------------------
 */

static inline Tcl_WideInt
NativeCalc100NsTicks(
    ULONGLONG fileTimeLastCall,
    LONGLONG perfCounterLastCall,
    LONGLONG curCounterFreq,
    LONGLONG curCounter
) {

    return fileTimeLastCall +
	((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq);
}

static Tcl_WideInt
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;

	    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 != (Tcl_WideInt)1193182
		     * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt)3579545
		     */
		    && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 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 */

	    /*
	     * If the performance counter is available, start a thread to
	     * calibrate it.
	     */

	    if (timeInfo.perfCounterAvailable) {
		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);







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




















|




|
<
>

|


|












<



<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




|







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
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
	/*
	 * 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 --







|
|








>











>

>
|
>
>














|
<
>
|
>
>

|
>






>







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
626
627
628
629
630

631

632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
 */

static void
NativeGetTime(
    Tcl_Time *timePtr,
    TCL_UNUSED(ClientData))
{
    Tcl_WideInt usecSincePosixEpoch;

    /*
     * Try to use high resolution timer.
     */

    if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) {

	timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
	timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
    } else {
	/*
	* High resolution timer is not available. Just use ftime.
	*/

	struct _timeb t;

	_ftime(&t);
	timePtr->sec = (long)t.time;
	timePtr->usec = t.millitm * 1000;
    }
}

/*
 *----------------------------------------------------------------------
 *







|




>
|
>




|
|




|







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


725


726
727
728
729
730
731
732
     */

    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);

    /*







>
>
|
>
>







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
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
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. */
    Tcl_WideInt estFreq;	/* Estimated perf counter frequency. */
    Tcl_WideInt vt0;		/* Tcl time right now. */
    Tcl_WideInt vt1;		/* Tcl time one second from now. */
    Tcl_WideInt tdiff;		/* Difference between system clock and Tcl
				 * time. */
    Tcl_WideInt 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)
    ) {

    	/* again in next one second */


	return;
    }
    QueryPerformanceCounter(&curPerfCounter);

    lastFileTime.QuadPart = curFileTime.QuadPart;

    /*







|
>


|
|
|
|

|










>
>
|
>
|
|
|
<
>
|
>
>







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
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
     * 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,
	    (Tcl_WideUInt) 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;
	Tcl_WideInt 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;







|



















|
|
>








>
|
>
>


>
|
>
>


>

|
|
|

>







>
|
>


>
|
>
>
|
|

|
|



|
|
|
>

>

|



|
|

|
|
>
|
>
|
>
>
>

>
>
|
>
>
>


>
|
>
>





>
|
>
>


>
|
>
>

>
|
>
>







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
970
971
972
973
974
975

976
977
978
979
980
981
982
 *	given frequency.
 *
 *----------------------------------------------------------------------
 */

static void
ResetCounterSamples(
    Tcl_WideUInt fileTime,	/* Current file time */
    Tcl_WideInt perfCounter,	/* Current performance counter */
    Tcl_WideInt 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;
}







|
|
|


|
>







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
1010
1011
1012
1013
1014

1015
1016
1017
1018

1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
 *
 * 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 Tcl_WideInt
AccumulateSample(
    Tcl_WideInt perfCounter,
    Tcl_WideUInt fileTime)
{

    Tcl_WideUInt workFTSample;	/* File time sample being removed from or
				 * added to the circular buffer. */
    Tcl_WideInt workPCSample;	/* Performance counter sample being removed
				 * from or added to the circular buffer. */

    Tcl_WideUInt lastFTSample;	/* Last file time sample recorded */
    Tcl_WideInt lastPCSample;	/* Last performance counter sample recorded */
    Tcl_WideInt FTdiff;		/* Difference between last FT and current */
    Tcl_WideInt PCdiff;		/* Difference between last PC and current */
    Tcl_WideInt estFreq;	/* Estimated performance counter frequency */

    /*
     * Test for jumps and reset the samples if we have one.
     */

    if (timeInfo.sampleNo == 0) {
	lastPCSample =







|

|
|

>
|

|

>
|
|
|
|
|







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
1057
1058
1059
1060
1061
1062
1063
1064
	 */

	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] = (Tcl_WideInt) fileTime;

	/*
	 * Advance the sample number.
	 */

	if (++timeInfo.sampleNo >= SAMPLES) {
	    timeInfo.sampleNo = 0;







|







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
31
32
33
34
35
36
37
38
39
	    <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}"/>
	    <!-- Windows Vista -->
	    <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
	</application>
    </compatibility>
    <asmv3:application>
	<asmv3:windowsSettings
		xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
	    <dpiAware>true</dpiAware>
	</asmv3:windowsSettings>







<
<







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>