Tcl Source Code

Changes On Branch rfe-854941
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki
Hide Diff Patch Side-by-Side Diff

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

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

Changes to .fossil-settings/encoding-glob. 

1
2
3
4
5
6
7
8
9


1
2
3
4
5
6
7


-







-

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

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

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"
# 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:




︙


136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157

128
129
130
131
132
133
134








135
136
137
138
139
140
141








-
-
-
-
-
-
-
-








        - 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: []




︙


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

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
        - 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
        - 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,msvcrt' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
        - 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

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 'OPTS=nodep' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=nodep' '-f' makefile.vc test
        - 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,msvcrt' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
        - 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

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




︙


380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402

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




︙


420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438

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








Changes to README.md.



1
2
3
4
5
6
7











8



9
10
11
12
13
14
15

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

19
20
21
22
23
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://travis-ci.org/tcltk/tcl.svg?branch=master)](https://travis-ci.org/tcltk/tcl)
[![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

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
takes place at [core.tcl-lang.org](https://core.tcl-lang.org/).
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
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.
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

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

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

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

1
2
3
4
5
6

7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
23
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 7.5 Tcl "Tcl Library Procedures"
.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 \- allocate or free heap memory
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

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

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

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 int *lengthPtr out
If non-NULL, filled with the length of the array of bytes in the value.
.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

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

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

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

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

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).
channel.  See \fBWATCHPROC\fR below for more details.
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

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,
        Tcl_WideInt \fIlength\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

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

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.
'\" 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

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

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

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

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.
'\" 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

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

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

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

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

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

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)
\fBTcl_FSFileAttrsGet\fR(\fIinterp, index, pathPtr, objPtrRef\fR)
.sp
int
\fBTcl_FSFileAttrsSet\fR(\fIinterp, int index, pathPtr, Tcl_Obj *objPtr\fR)
\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

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
Tcl_WideInt
long long
\fBTcl_GetAccessTimeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetBlockSizeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideUInt
unsigned long long
\fBTcl_GetBlocksFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideInt
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
Tcl_WideInt
long long
\fBTcl_GetModificationTimeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideUInt
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

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_PackageInitProc **proc1Ptr out
.AP Tcl_LibraryInitProc **proc1Ptr out
Filled with the init function for this code.
.AP Tcl_PackageInitProc **proc2Ptr out
.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

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

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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" 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

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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 1996 by Sun Microsystems, Inc.
'\" 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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 2001 by Kevin B. Kenny <[email protected]>.
'\" 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

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

1

2
3
4

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
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 by Scriptics Corporation.
'\" Copyright (c) 1998-2000 Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
.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

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

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

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

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

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

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), oo::class(n), oo::define(n), oo::object(n)
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

1


2
3
4
5
6
7
8
9
10


-
-
+
+








.\"
.\" Copyright (c) 2008 by Kevin B. Kenny.
.\" Copyright (c) 2018 by Nathan Coulter.
.\" 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



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 (c) 2008 by Kevin B. Kenny.
Copyright (c) 2018 by Nathan Coulter.
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

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)
\fBTcl_GetNamespaceUnknownHandler\fR(\fIinterp, nsPtr\fR)
.sp
int
\fBTcl_SetNamespaceUnknownHandler(\fIinterp, nsPtr, handlerPtr\fR)
\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

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

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

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

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
long long
\fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
.sp
Tcl_WideInt
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

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

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

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

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


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_StaticPackage(3)
package(n), Tcl_StaticLibrary(3)








Changes to doc/RecEvalObj.3.




︙


40
41
42
43
44
45
46






47
48
49
50
51

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

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


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
embedding, configuration, library








Changes to doc/RegExp.3.




︙


373
374
375
376
377
378
379
















380
381
382
383

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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" 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

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.
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 current definition of a Tcl channel driver does not permit the direct
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 \fBbypass areas\fR defined for channels
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

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

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

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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" 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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 2001 by ActiveState Corporation
'\" 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

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

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

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

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.
'\" 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

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

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

1
2
3
4
5
6
7
8

9
10
11
12

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61









-
+



-
+






+
+
+
+













+
+
+
+












+
+








'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures"
.TH Tcl_Main 3 9.0 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
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

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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" 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

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

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, 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.
\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.
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 - \fBTCL_UTF_MAX\fR).  The character that begins
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[-\fBTCL_UTF_MAX\fI-1]\fR.
\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

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

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

1


2
3
4
5
6
7
8
9
10


-
-
+
+








'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Copyright (c) 2008 by Donal K. Fellows
'\" 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

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

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

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

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

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

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

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

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

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

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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 1998 by Scriptics Corporation.
'\" 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

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

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




︙


291
292
293
294
295
296
297
298

299
300
301
302

303
304
305
306
307
308
309

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 NT 32-bit system directory.
The Windows 32-bit system directory.
.IP \(bu 3
The Windows NT 16-bit system directory.
.IP \(bu 3
The Windows NT home directory.
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

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

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
'\" 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

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

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

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]}
\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

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 by Kevin B. Kenny <[email protected]>. All rights reserved.
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

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

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
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:
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 sets or retrieves the octal code that chmod(1)
uses.  This command does also has limited support for setting using the
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
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).
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

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).  Also Windows 3.1 only supports file
native path names).
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 .




︙







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

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
'\" 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
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

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

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

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

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 to the server. The \fIquery\fR must be an x-url-encoding
formatted query.  The \fB::http::formatQuery\fR procedure can be used to
\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.
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

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

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
.
Either \fBok\fR, for successful completion, \fBreset\fR for
user-reset, \fBtimeout\fR if a timeout occurred before the transaction
See description in the chapter \fBERRORS\fR above for a
list and description of \fBstatus\fR.
could complete, or \fBerror\fR for an error condition.  During the
transaction this value is the empty string.
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

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.
'\" 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

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

9
10
11
12
13
14
15

16
17

18
19
20
21
22
23

24
25
26
27


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 packageName\fR
\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 packageName interp\fR
\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 package to incorporate it into an interpreter.  \fIfileName\fR
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.
\fIpackageName\fR is the name of the package, and is used to
compute the name of an initialization procedure.
\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 package (see the \fBinterp\fR manual entry for details);
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
\fIpackageName\fR and whether or not the target interpreter
\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 \fIpkg\fB_Init\fR, where \fIpkg\fR
procedure will have the form \fIprefix\fB_Init\fR.  For example, if
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
\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 \fIpkg\fB_SafeInit\fR
instead of \fIpkg\fB_Init\fR.
The \fIpkg\fB_SafeInit\fR function should be written carefully, so that it
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 package that is safe for use by untrusted code. For more information
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_PackageInitProc\fR(
typedef int \fBTcl_LibraryInitProc\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
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
package. From version 8.5 however, the \fBunload\fR command allows the unloading
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 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
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 \fIpackageName\fR is omitted or specified as an empty string,
Tcl tries to guess the name of the package.
If \fIprefix\fR is omitted or specified as an empty string,
Tcl tries to guess the prefix by taking the last element of
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.
\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 \fIpackageName\fR must
If \fIfileName\fR is an empty string, then \fIprefix\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
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
package by that name, and uses it if it is found.  If several
library 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.
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 packageName to the \fBload\fR command.
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

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_StaticPackage(3), safe(n)
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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 2018 by Peter Spjuth.  All rights reserved.
'\" 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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 2003 by Simon Geard.  All rights reserved.
'\" 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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 2006 by Donal K. Fellows.  All rights reserved.
'\" 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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 2001 by Kevin B. Kenny <[email protected]>.  All rights reserved.
'\" 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

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
'\" 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
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

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

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

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.
'\" 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

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

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

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

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

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

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

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

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

1

2
3
4
5
6
7
8
9


-
+








'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" 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

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

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

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
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 ,
.QW \fB[[=\(^o=]]\fR ,
and
.QW \fB[o\[^o]]\fR \&
.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

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:]_]\fR (note underscore)
\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:]_]\fR (note underscore)
\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

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

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

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

1
2

3
4
5
6
7
8
9
10



-
+








'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 by Scriptics Corporation.
'\" 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

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

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

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




︙







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

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

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
\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 \fIpkg\fB_Unload\fR, where \fIpkg\fR
is the same as \fIpackageName\fR except that the first letter is
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 \fIpackageName\fR is
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_PackageUnloadProc\fR(
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

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 \fIpackageName\fR argument must
If \fIfileName\fR is an empty string, then the \fIprefix\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.
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

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

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

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

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

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

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

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

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

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

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('*');
	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

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

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

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

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

1
2
3

4
5
6
7
8
9
10
11




-
+








/*
 * regerror - error-code expansion
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 * 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

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

1
2
3

4
5
6
7
8
9
10
11




-
+








/*
 * regfree - free an RE
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 * 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

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

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

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 {
declare 9 {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    void *clientData)
}
declare 10 unix {
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

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

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

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

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

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

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

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

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

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

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

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)

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

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





︙


98
99
100
101
102
103
104



105


106
107
108
109
110
111
112

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

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

#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
#   define HAVE_DECLSPEC 1
#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

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

/* 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))
 *
 * 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(TCL_WIDE_INT_TYPE) && !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__GNUC__)
#   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
#   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 */
#   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"
#	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

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

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

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

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 Tcl_WideInt (Tcl_DriverWideSeekProc) (void *instanceData,
			Tcl_WideInt offset, int mode, int *errorCodePtr);
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,
			Tcl_WideInt length);
			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

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

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)()))
	    ((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 const char *	Tcl_InitSubsystems(void);
EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
EXTERN void		Tcl_FindExecutable(const char *argv0);
EXTERN void		Tcl_SetPanicProc(
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_StaticPackage(Tcl_Interp *interp,
			    const char *pkgName,
			    Tcl_PackageInitProc *initProc,
			    Tcl_PackageInitProc *safeInitProc);
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 int		TclZipfs_AppHook(int *argc, wchar_t ***argv);
EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
EXTERN int		TclZipfs_AppHook(int *argc, char ***argv);
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

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

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

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

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

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));
	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] * (1 << (i + 3));
	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 (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
    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

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

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

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

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

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

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

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

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

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

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

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

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;
    cmdPtr->refCount++;

    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

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;
    cmdPtr->refCount--;
    iPtr->activeCmdTracePtr = active.nextPtr;
    Tcl_Release(iPtr);
    return result;
}

/*
 *----------------------------------------------------------------------




︙


3950
3951
3952
3953
3954
3955
3956
3957

3958
3959
3960
3961
3962
3963
3964

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

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 = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }




︙


4548
4549
4550
4551
4552
4553
4554
4555

4556
4557
4558
4559
4560
4561
4562

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 = TclGetStringFromObj(listPtr, &cmdLen);
	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

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 = TclGetStringFromObj(commandPtr, &length);
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the
     * traces so that the structure doesn't go away underneath our feet.
     */




︙


4746
4747
4748
4749
4750
4751
4752
4753

4754
4755
4756
4757
4758
4759
4760

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 = TclGetStringFromObj(commandPtr, &length);
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_DYING)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {




︙


5988
5989
5990
5991
5992
5993
5994
5995

5996
5997
5998
5999
6000
6001
6002

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 = TclGetStringFromObj(objPtr, &numSrcBytes);
	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

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 = TclGetStringFromObj(objPtr, &numSrcBytes);
	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}

	/*
	 * We are returning to level 0, so should call TclResetCancellation.
	 * Let us just unset the flags inline.
	 */




︙


6550
6551
6552
6553
6554
6555
6556
6557

6558
6559
6560
6561
6562
6563
6564

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 = TclGetStringFromObj(objPtr, &length);
    const char *message = Tcl_GetStringFromObj(objPtr, &length);
    Interp *iPtr = (Interp *) interp;

    Tcl_IncrRefCount(objPtr);

    /*
     * If we are just starting to log an error, errorInfo is initialized from
     * the error message in the interpreter's result.




︙


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

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 = TclGetStringFromObj(objv[1], &numBytes);
		const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
			return TCL_OK;
		    }
		    bytes++; 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;
		}
	    if (mp_init_i64(&big, l) != MP_OKAY) {
	    } 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

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

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

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

	    *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

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

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)TclGetByteArrayFromObj(objv[arg], &count);
		(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

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




︙


1271
1272
1273
1274
1275
1276
1277
1278

1279
1280
1281
1282
1283
1284
1285

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




︙


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

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 = TclGetByteArrayFromObj(objv[1], &length);
    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 '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

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
	     * Trim trailing nulls and spaces, if necessary.
	     * nulls and spaces, if necessary.
	     */

	    if (cmd == 'A') {
	    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

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

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 *) TclGetStringFromObj(objv[objc - 1], &count);
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;




︙


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

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 = TclGetStringFromObj(objv[i + 1], &wrapcharlen);
		wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen);
	    }
	    break;
	}
    }
    if (wrapcharlen == 0) {
	maxlen = 0;
    }

    TclNewObj(resultObj);
    data = TclGetByteArrayFromObj(objv[objc - 1], &count);
    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

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

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 = TclGetByteArrayFromObj(objv[objc - 1], &count);
    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

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 *) TclGetStringFromObj(objv[objc - 1], &count);
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;





︙


3189
3190
3191
3192
3193
3194
3195
3196

3197
3198
3199
3200
3201
3202
3203

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 *) TclGetStringFromObj(objv[objc - 1], &count);
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;




︙







Changes to generic/tclCkalloc.c.



1
2
3
4
5
6
7
8
9
10



11
12
13
14
15
16
17

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

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

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 = TclGetString(objv[1]);
    varValue = getenv(varName);
    varName = Tcl_UtfToWCharDString(TclGetString(objv[1]), -1, &ds);
    varValue = _wgetenv(varName);
    if (varValue == NULL) {
	Tcl_DStringFree(&ds);
    } else {
	Tcl_DStringSetLength(&ds, 0);
	varValue = "";
	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));
	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

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) now.sec * 1000 + now.usec / 1000;
	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();
	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

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 char* tzWas = (char *)INT2PTR(-1);	/* Previous value of TZ, protected by
				 * clockMutex. */
    const char *tzIsNow;	/* Current value of TZ */
    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 == INT2PTR(-1)
	    || strcmp(tzIsNow, tzWas) != 0)) {
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == (WCHAR *)INT2PTR(-1)
	    || wcscmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
	if (tzWas != NULL && tzWas != (WCHAR *)INT2PTR(-1)) {
	    Tcl_Free(tzWas);
	}
	tzWas = (char *)Tcl_Alloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
	tzWas = (WCHAR *)Tcl_Alloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1));
	wcscpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) Tcl_Free(tzWas);
	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

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

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

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

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

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

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




︙


2208
2209
2210
2211
2212
2213
2214
2215

2216
2217
2218
2219
2220
2221
2222

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

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

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

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

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

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) */
	"\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

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

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

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

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

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

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




︙


1615
1616
1617
1618
1619
1620
1621
1622

1623
1624
1625
1626
1627
1628
1629

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

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

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

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

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

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

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

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

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

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);
	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 = TclGetUnicodeFromObj(mapElemv[1], &mapLen);
	    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

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

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

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 char *p, *string;
    size_t numChars, length, cur, index;
    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 = TclGetStringFromObj(objv[1], &length);
    string = Tcl_GetUnicodeFromObj(objv[1], &length);
    numChars = Tcl_NumUtfChars(string, length) - 1;
    if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) {
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = TclGetString(objv[1]);
    if (index + 1 > numChars + 1) {
	index = numChars;
    if (index + 1 >= length + 1) {
	index = length - 1;
    }
    cur = 0;
    if (index + 1 > 1) {
	p = Tcl_UtfAtIndex(string, index);
	p = &string[index];

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

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

	    next = TclUtfPrev(p, string);
	    next = TclUCS4Prev(p, string);
	    do {
		next += delta;
		delta = TclUtfToUCS4(next, &ch);
		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

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 char *p, *end, *string;
    size_t length, numChars, cur, index;
    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 = TclGetStringFromObj(objv[1], &length);
    string = Tcl_GetUnicodeFromObj(objv[1], &length);
    numChars = Tcl_NumUtfChars(string, length) - 1;
    if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) {
    if (TclGetIntForIndexM(interp, objv[2], length-1, &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);
    if (index + 1 <= length + 1) {
	p = &string[index];
	end = string+length;
	for (cur = index; p < end; cur++) {
	    p += TclUtfToUCS4(p, &ch);
	    p += TclUniCharToUCS4(p, &ch);
	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }
	}
	if (cur == index) {
	    cur++;
	}
    } else {
	cur = numChars + 1;
	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

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 = TclGetStringFromObj(objv[i], &length);
	string2 = Tcl_GetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string2, "-nocase", length)) {
	    nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string2, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }




︙


2753
2754
2755
2756
2757
2758
2759
2760

2761
2762
2763
2764
2765
2766
2767

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 = TclGetStringFromObj(objv[i], &length);
	string = Tcl_GetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string, "-nocase", length)) {
	    *nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }




︙


2854
2855
2856
2857
2858
2859
2860
2861

2862
2863
2864
2865
2866
2867
2868

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

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

    if (objc == 2) {
	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);

	length1 = Tcl_UtfToLower(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);




︙


2962
2963
2964
2965
2966
2967
2968
2969

2970
2971
2972
2973
2974
2975
2976

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 = TclGetStringFromObj(objv[1], &length1);
	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToLower(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));




︙


3012
3013
3014
3015
3016
3017
3018
3019

3020
3021
3022
3023
3024
3025
3026

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

    if (objc == 2) {
	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);

	length1 = Tcl_UtfToUpper(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);




︙


3047
3048
3049
3050
3051
3052
3053
3054

3055
3056
3057
3058
3059
3060
3061

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 = TclGetStringFromObj(objv[1], &length1);
	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToUpper(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));




︙


3097
3098
3099
3100
3101
3102
3103
3104

3105
3106
3107
3108
3109
3110
3111

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

    if (objc == 2) {
	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);

	length1 = Tcl_UtfToTitle(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);




︙


3132
3133
3134
3135
3136
3137
3138
3139

3140
3141
3142
3143
3144
3145
3146

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 = TclGetStringFromObj(objv[1], &length1);
	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToTitle(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));




︙


3177
3178
3179
3180
3181
3182
3183
3184

3185
3186
3187
3188
3189
3190
3191
3192

3193
3194
3195
3196
3197
3198
3199

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 = TclGetStringFromObj(objv[2], &length2);
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

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

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




︙


3225
3226
3227
3228
3229
3230
3231
3232

3233
3234
3235
3236
3237
3238
3239
3240

3241
3242
3243
3244
3245
3246
3247

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 = TclGetStringFromObj(objv[2], &length2);
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

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

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




︙


3272
3273
3274
3275
3276
3277
3278
3279

3280
3281
3282
3283
3284
3285
3286
3287

3288
3289
3290
3291
3292
3293
3294

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 = TclGetStringFromObj(objv[2], &length2);
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

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

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




︙


3693
3694
3695
3696
3697
3698
3699
3700

3701
3702
3703
3704
3705
3706
3707

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 = TclGetStringFromObj(objv[i], &patternLength);
	pattern = Tcl_GetStringFromObj(objv[i], &patternLength);

	if ((i == objc - 2) && (*pattern == 'd')
		&& (strcmp(pattern, "default") == 0)) {
	    Tcl_Obj *emptyObj = NULL;

	    /*
	     * If either indexVarObj or matchVarObj are non-NULL, we're in




︙







Changes to generic/tclCompCmds.c.



1
2
3
4
5
6
7
8
9
10




11
12
13
14
15
16
17

1
2
3
4
5
6




7
8
9
10
11
12
13
14
15
16
17







-
-
-
-
+
+
+
+








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

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

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

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

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

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

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

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

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

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

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

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

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

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

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




︙


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

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

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




︙


3126
3127
3128
3129
3130
3131
3132
3133

3134
3135
3136
3137
3138
3139
3140

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

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

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

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

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		/* " */,	INVALID		/* # */,
	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

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

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

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

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;
    Tcl_UniChar ch = 0;
    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

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 = TclUtfToUniChar(start, &ch);
	    scanned = TclUtfToUCS4(start, &ch);
	} else {
	    char utfBytes[4];
	    char utfBytes[8];

	    memcpy(utfBytes, start, numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUniChar(utfBytes, &ch);
	    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

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 = TclGetStringFromObj(*funcObjv, &length);
		p = Tcl_GetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
		Tcl_DStringFree(&cmdName);





︙


2458
2459
2460
2461
2462
2463
2464
2465

2466
2467
2468
2469
2470
2471
2472

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 = TclGetStringFromObj(literal, &length);
		const char *bytes = Tcl_GetStringFromObj(literal, &length);
		int idx = TclRegisterLiteral(envPtr, bytes, length, 0);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);

		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *




︙


2518
2519
2520
2521
2522
2523
2524
2525

2526
2527
2528
2529
2530
2531
2532

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
				= TclGetStringFromObj(objPtr, &numBytes);
				= Tcl_GetStringFromObj(objPtr, &numBytes);

			idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
			tableValue = TclFetchLiteral(envPtr, idx);
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
			    /*
			     * Same 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

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

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

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

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

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

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

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

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

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

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

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);
#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 */




︙


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

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 *	Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
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 *		Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
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

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);
#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 */




︙


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

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		Tcl_UtfCharComplete(const char *src, size_t length);
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 *	Tcl_UtfNext(const char *src);
EXTERN const char *	TclUtfNext(const char *src);
/* 331 */
EXTERN const char *	Tcl_UtfPrev(const char *src, const char *start);
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

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 *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
EXTERN Tcl_UniChar *	TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr);
				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

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

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 Tcl_WideInt	Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
EXTERN long long	Tcl_Seek(Tcl_Channel chan, long long offset,
				int mode);
/* 492 */
EXTERN Tcl_WideInt	Tcl_Tell(Tcl_Channel chan);
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

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,
				Tcl_WideInt length);
				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

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 Tcl_WideInt	Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
EXTERN long long	Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
/* 597 */
EXTERN Tcl_WideInt	Tcl_GetModificationTimeFromStat(
EXTERN long long	Tcl_GetModificationTimeFromStat(
				const Tcl_StatBuf *statPtr);
/* 598 */
EXTERN Tcl_WideInt	Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
EXTERN long long	Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
/* 599 */
EXTERN Tcl_WideUInt	Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
EXTERN unsigned long long Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
/* 600 */
EXTERN Tcl_WideUInt	Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr);
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

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




︙


1807
1808
1809
1810
1811
1812
1813
1814

1815
1816
1817
1818
1819
1820
1821
1822

1823
1824
1825
1826
1827
1828
1829

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 * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
    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 * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
    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

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 */
#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);




︙


2108
2109
2110
2111
2112
2113
2114
2115

2116
2117
2118
2119
2120


2121
2122
2123
2124
2125
2126
2127

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 (*tcl_UtfCharComplete) (const char *src, size_t length); /* 326 */
    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 * (*tcl_UtfNext) (const char *src); /* 330 */
    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
    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

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 * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    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_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 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); /* 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

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 */
    Tcl_WideInt (*tcl_Seek) (Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 491 */
    Tcl_WideInt (*tcl_Tell) (Tcl_Channel chan); /* 492 */
    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

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, Tcl_WideInt length); /* 560 */
    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

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

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

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




︙


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

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 Tcl_GetByteArrayFromObj \
	(tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */
#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 Tcl_GetStringFromObj \
	(tclStubsPtr->tcl_GetStringFromObj) /* 41 */
#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

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




︙


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

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 Tcl_UtfCharComplete \
	(tclStubsPtr->tcl_UtfCharComplete) /* 326 */
#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 Tcl_UtfNext \
	(tclStubsPtr->tcl_UtfNext) /* 330 */
#define Tcl_UtfPrev \
	(tclStubsPtr->tcl_UtfPrev) /* 331 */
#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

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 Tcl_GetUnicodeFromObj \
	(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */
#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

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

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




︙


3817
3818
3819
3820
3821
3822
3823

























3824
3825
3826
3827
3828
3829
3830

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

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




︙


3922
3923
3924
3925
3926
3927
3928
3929
3930
3931



3932
3933

3934
3935
3936
3937
3938
3939
3940

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)

#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX <= 3)
#   undef Tcl_UtfCharComplete
#   define Tcl_UtfCharComplete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
#undef TclUnusedStubEntry
#undef TclUtfCharComplete
#undef TclUtfNext
	    ? ((length) >= TCL_UTF_MAX) : tclStubsPtr->tcl_UtfCharComplete((src), (length)))
#endif
#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

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

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

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

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

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	elem = Tcl_GetStringFromObj(valuePtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    (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

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

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

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

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

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

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 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	UtfToUtfProc;
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].




︙


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

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

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




︙


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

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 (\xC080). To get
	 * 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 {
	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';
    }




︙


1265
1266
1267
1268
1269
1270
1271
1272
1273


1274
1275
1276
1277
1278
1279
1280

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

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

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
void
const char *
Tcl_FindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    Tcl_InitSubsystems();
    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

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;
}

/*
 *-------------------------------------------------------------------------
 *
 * 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),
    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_EncodingState *statePtr,/* Place for conversion routine to store state
    TCL_UNUSED(Tcl_EncodingState *),
				 * 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
    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;

    int ch;
    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;
    flags |= PTR2INT(clientData);
    dstEnd = dst + dstLen - TCL_UTF_MAX;

    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	if ((src > srcClose) && (!TclUCS4Complete(src, srcEnd - src))) {
	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 && pureNullMode == 0)) {
	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 (pureNullMode == 1 && UCHAR(*src) == 0xC0 &&
		(src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
	} 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 (!TclUCS4Complete(src, srcEnd - src)) {
	} 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.
	     * 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;
		}
	    *chPtr = UCHAR(*src);
	    src += 1;
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
		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;
	    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;
	    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(*chPtr, dst);
		*chPtr = low;
		dst += Tcl_UniCharToUtf(ch, dst);
		ch = low;
	    }
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
	    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

2256
2257
2258
2259
2260
2261
2262

2263
2264
2265
2266
2267
2268
2269
2270








-
+








 *	None.
 *
 *-------------------------------------------------------------------------
 */

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

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

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,	/* != NULL means LE, == NUL means BE */
    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_EncodingState *statePtr,/* Place for conversion routine to store state
    TCL_UNUSED(Tcl_EncodingState *),
				 * 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;

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

	src += TclUtfToUCS4(src, &ch);
	if (flags & TCL_ENCODING_LE) {
	if (clientData) {
#if TCL_UTF_MAX > 3
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (*chPtr >> 8);
	    if (ch <= 0xFFFF) {
		*dst++ = (ch & 0xFF);
		*dst++ = (ch >> 8);
	    } else {
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
		*dst++ = (((ch - 0x10000) >> 10) & 0xFF);
		*dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (ch & 0xFF);
		*dst++ = ((ch >> 8) & 0x3) | 0xDC;
	    }
#else
	    *dst++ = (*chPtr & 0xFF);
	    *dst++ = (*chPtr >> 8);
#endif
	} else {
#if TCL_UTF_MAX > 3
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr >> 8);
		*dst++ = (*chPtr & 0xFF);
	    if (ch <= 0xFFFF) {
		*dst++ = (ch >> 8);
		*dst++ = (ch & 0xFF);
	    } else {
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
		*dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (((ch - 0x10000) >> 10) & 0xFF);
		*dst++ = ((ch >> 8) & 0x3) | 0xDC;
		*dst++ = (ch & 0xFF);
	    }
#else
	    *dst++ = (*chPtr >> 8);
	    *dst++ = (*chPtr & 0xFF);
#endif
	}
    }
    *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

2460
2461
2462
2463
2464
2465
2466

2467
2468
2469
2470
2471
2472
2473
2474








-
+








 *	None.
 *
 *-------------------------------------------------------------------------
 */

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
	    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

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

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

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);
	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 = TclGetStringFromObj(o, &s2len);
		    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

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);
	    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 = TclGetStringFromObj(valuePtr, &slength);
	    s1 = Tcl_GetStringFromObj(valuePtr, &slength);
	    TclNewStringObj(objResultPtr, s1, slength);
	    slength = Tcl_UtfToLower(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, slength);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    slength = Tcl_UtfToLower(TclGetString(valuePtr));
	    Tcl_SetObjLength(valuePtr, slength);
	    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);
	    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

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

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

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",
	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 => %d\n",
	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 = TclGetUnicodeFromObj(valuePtr, &slength);
	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

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);
	    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 = TclGetByteArrayFromObj(valuePtr, &wlen1);
	    bytes2 = TclGetByteArrayFromObj(value2Ptr, &wlen2);
	    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

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);
	string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(valuePtr, &slength);
	trim1 = TclTrimLeft(string1, slength, string2, length2);
	trim2 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM_RIGHT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(valuePtr, &slength);
	trim2 = TclTrimRight(string1, slength, string2, length2);
	trim1 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(valuePtr, &slength);
	trim1 = TclTrim(string1, slength, string2, length2, &trim2);
    createTrimmedString:
	/*
	 * Careful here; trim set often contains non-ASCII characters so we
	 * take care when printing. [Bug 971cb4f1db]
	 */





︙


9313
9314
9315
9316
9317
9318
9319
9320

9321
9322
9323
9324
9325
9326
9327

9313
9314
9315
9316
9317
9318
9319

9320
9321
9322
9323
9324
9325
9326
9327








-
+








 *	None.
 *
 *----------------------------------------------------------------------
 */

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

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

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 >= 0;  i--) {
    for (i = 31;  i != (size_t)-1;  i--) {
	if (statsPtr->srcCount[i] > 0) {
	    maxSizeDecade = i;
	    break;
	    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 >= 0;  i--) {
    for (i = 31;  i != (size_t)-1;  i--) {
	if (statsPtr->byteCodeCount[i] > 0) {
	    maxSizeDecade = i;
	    break;
	    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 >= 0;  i--) {
    for (i = 31;  i != (size_t)-1;  i--) {
	if (statsPtr->lifetimeCount[i] > 0) {
	    maxSizeDecade = i;
	    break;
	    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

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 = TclGetStringFromObj(objv[1], &length);
	char *str = Tcl_GetStringFromObj(objv[1], &length);

	if (length) {
	    if (strcmp(str, "stdout") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDOUT);
	    } else if (strcmp(str, "stderr") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDERR);
	    } else {




︙







Changes to generic/tclFCmd.c.



1
2
3
4
5
6
7

8
9
10
11
12
13
14

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

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

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

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

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

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

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

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

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

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

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

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




︙


857
858
859
860
861
862
863
864

865
866
867
868
869
870
871

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

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

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

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

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

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

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

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




︙


2368
2369
2370
2371
2372
2373
2374
2375

2376
2377
2378
2379
2380
2381
2382

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

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

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

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

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
long long
Tcl_GetAccessTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_atime;
    return (long long) statPtr->st_atime;
}

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

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

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

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

    return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
    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

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

1
2
3
4
5
6
7
8
9

10
11
12
13
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) 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 and Mark Diekhans.
 * 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

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

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

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

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

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 (statePtr->flags & CHANNEL_INCLOSE) {
    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

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 *) TclGetByteArrayFromObj(objPtr, &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

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 *) TclGetByteArrayFromObj(objPtr, &srcLen);
	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
	return WriteBytes(chanPtr, src, srcLen);
    } else {
	src = TclGetStringFromObj(objPtr, &srcLen);
	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

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)TclGetStringFromObj(objPtr, &oldLength);
    (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

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 = TclGetByteArrayFromObj(objPtr, &byteLen);
    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

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) TclGetStringFromObj(objPtr, &numBytes);
    (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

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

Tcl_WideInt
long long
Tcl_Seek(
    Tcl_Channel chan,		/* The channel on which to seek. */
    Tcl_WideInt offset,		/* Offset to seek to. */
    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. */
    Tcl_WideInt curPos;		/* Position on the device. */
    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

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

Tcl_WideInt
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. */
    Tcl_WideInt curPos;		/* Position on device. */
    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

7210
7211
7212
7213
7214
7215
7216

7217
7218
7219
7220
7221
7222
7223
7224








-
+








 *
 *---------------------------------------------------------------------------
 */

int
Tcl_TruncateChannel(
    Tcl_Channel chan,		/* Channel to truncate. */
    Tcl_WideInt length)		/* Length to truncate it to. */
    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

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;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /* 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.
	 */
	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);
    }
	    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

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
     * or not this is a new record or a modification of an old one.
     * 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

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. */
    Tcl_WideInt toRead,		/* Amount of data to copy, or -1 for all. */
    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

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 = TclGetStringFromObj(bufObj, &sizeb);
	    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

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;

    if (iPtr->chanMsg != NULL) {
	TclDecrRefCount(iPtr->chanMsg);
	iPtr->chanMsg = NULL;
    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

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;

    if (statePtr->chanMsg != NULL) {
	TclDecrRefCount(statePtr->chanMsg);
	statePtr->chanMsg = NULL;
    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

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

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

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

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

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

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

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

    case TRANSMIT_IBUF:
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(resObj, &resLen);
	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

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
static long long
TransformWideSeekProc(
    ClientData instanceData,	/* The channel to manipulate. */
    Tcl_WideInt offset,		/* Size of movement. */
    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);
    ClientData parentData = Tcl_GetChannelInstanceData(parent);
    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

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

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 Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);
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. This is
 * The C layer channel type/driver definition used by the reflection.
 * 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 */
    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 */
    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

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

231
232
233
234
235
236
237

238
239
240
241
242
243
244
245
246








-
+
+








    ForwardedInput,
    ForwardedOutput,
    ForwardedSeek,
    ForwardedWatch,
    ForwardedBlock,
    ForwardedSetOpt,
    ForwardedGetOpt,
    ForwardedGetOptAll
    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

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

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

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

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. We simply clean up all
	 * our C level data structures and leave the Tcl level to the other
	 * 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

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

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

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 = TclGetStringFromObj(resObj, &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

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

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 = TclGetStringFromObj(cmd, &cmdLen);
		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rcPtr->interp);
		Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
			cmdLen);




︙


3035
3036
3037
3038
3039
3040
3041
3042

3043
3044
3045
3046
3047
3048
3049

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

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 = TclGetStringFromObj(resObj, &len);
		const char *str = Tcl_GetStringFromObj(resObj, &len);

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

    case ForwardedTruncate: {
	Tcl_Obj *lenObj = Tcl_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

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 = TclGetStringFromObj(obj, &len);
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

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




︙







Changes to generic/tclIORTrans.c.



1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = TclGetStringFromObj(norm, &len2);
	    str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = Tcl_GetStringFromObj(norm, &len2);
	    if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
		/*
		 * The pathname values are equal so retain the old pathname
		 * object which is probably already shared and free the
		 * normalized pathname that was just produced.
		 */
	    cdEqual:




︙


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

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_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
    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_PackageInitProc *) procPtrs[0];
	*proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1];
	*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

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

3103
3104
3105
3106
3107
3108
3109

3110
3111
3112
3113
3114
3115
3116
3117








-
+








     */


#ifdef hpux
    (void)shlibFile;
    return 1;
#else
    char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");
    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

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

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 = TclGetStringFromObj(pathPtr, &pathLen);
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

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

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




︙


4079
4080
4081
4082
4083
4084
4085
4086

4087
4088
4089
4090
4091
4092
4093

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

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

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 = TclGetStringFromObj(normPath, &normLen);
		cwdStr = TclGetStringFromObj(cwdPtr, &cwdLen);
		normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
		cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
		if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
			normLen) == 0)) {
		    /*
		     * The cwd is inside the directory to be removed.  Change
		     * the cwd to [file dirname $path].
		     */





︙







Changes to generic/tclIndexObj.c.



1
2
3
4
5
6
7
8
9
10



11
12
13
14
15
16
17

1
2
3
4
5
6
7



8
9
10
11
12
13
14
15
16
17








-
-
-
+
+
+








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

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

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

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

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




︙


668
669
670
671
672
673
674
675

676
677
678
679
680
681

682
683
684
685
686
687
688

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

    resultString = NULL;
    resultLength = 0;

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

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

	if ((length > elemLength) ||




︙


714
715
716
717
718
719
720
721

722
723
724
725
726
727
728

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

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

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

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

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[] = "                    ";
    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.
     */





︙


1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297

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




︙







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

1
2
3
4
5
6
7



8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26










27
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 (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
# 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.

# 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)
    unsigned long long TclpGetClicks(void)
}
declare 76 {
    Tcl_WideUInt TclpGetSeconds(void)
    unsigned long long 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:
# Removed in 9.0:
#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,
#declare 101 {
#    const char *TclSetPreInitScript(const char *string)
#	    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 {




︙


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

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




︙


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

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

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




︙


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

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

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




︙


864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887

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




︙


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

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[])
}
#  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,




︙


951
952
953
954
955
956
957
958
959
960
961
962



963


964
965
966
967
968
969
970

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 337 made this one public
#declare 236 {
#    void TclBackgroundException(Tcl_Interp *interp, int code)
# 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

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, Tcl_WideInt toRead, Tcl_Obj *cmdPtr)
	    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

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 TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
    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)
}
# TIP 542
declare 259 {
    void TclAppendUnicodeToObj(Tcl_Obj *objPtr,
	    const Tcl_UniChar *unicode, size_t length)
}


declare 260 {
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

################################
# Windows specific functions
# Platform 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 0 {unix win} {
#    void TclWinConvertError(unsigned errCode)
#}
# Removed in 9.0:
#declare 2 win {
#    struct servent *TclWinGetServByName(const char *nm,
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)
#	    const char *proto)
#}
# Removed in 9.0:
#declare 3 win {
#    int TclWinGetSockOpt(SOCKET s, int level, int optname,
}
declare 3 {unix win} {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
#	    char *optval, int *optlen)
#}
declare 4 win {
}
declare 4 {unix win} {
    void *TclWinGetTclInstance(void)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 5 win {
declare 5 {unix 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 {
declare 6 {unix win} {
#    unsigned short TclWinNToHS(unsigned short ns)
#}
# Removed in 9.0:
#declare 7 win {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 7 {unix win} {
#    int TclWinSetSockOpt(SOCKET s, int level, int optname,
#	    const char *optval, int optlen)
    TclFile TclpOpenFile(const char *fname, int mode)
#}
declare 8 win {
}
declare 8 {unix win} {
    size_t TclpGetPid(Tcl_Pid pid)
}
# Removed in 9.0:
#declare 9 win {
declare 9 {unix 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)
#}

    TclFile TclpCreateTempFile(const char *contents)
# Pipe channel functions

declare 11 win {
}
declare 11 {unix win} {
    void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 12 win {
    int TclpCloseFile(TclFile file)
    int TclpCloseFile_(TclFile file)
}
declare 13 win {
    Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
    Tcl_Channel TclpCreateCommandChannel_(TclFile readFile,
	    TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 14 win {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
declare 14 {unix win} {
    int TclpCreatePipe_(TclFile *readPipe, TclFile *writePipe)
}
declare 15 win {
declare 15 {unix 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 {
declare 16 {unix 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 {
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)
    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)
    TclFile TclpOpenFile_(const char *fname, int mode)
}
declare 20 win {
declare 20 {unix 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)
declare 22 {unix win} {
    TclFile TclpCreateTempFile_(const char *contents)
}
# Removed in 8.6:
#declare 23 win {
#    char *TclpGetTZName(int isdst)
#}
declare 24 win {
declare 24 {unix 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 {
declare 27 {unix 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} {
declare 29 {unix win} {
    int TclWinCPUID(int index, int *regs)
}
# Added in 8.6; core of TclpOpenTemporaryFile
declare 30 {win unix} {
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

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_NotifierProcs tclNotifierHooks;

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

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	TclGetLoadedPackagesEx(Tcl_Interp *interp,
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

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

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

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 TclUCS4Complete Tcl_UtfCharComplete
#   define TclUCS4Prev(src, ptr) (((src) > (ptr)) ? ((src) - 1) : (src))
#   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);
    MODULE_SCOPE int	TclUtfToUCS4(const char *, int *);
    MODULE_SCOPE int	TclUniCharToUCS4(const Tcl_UniChar *, int *);
#   define TclUCS4Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
	    ? ((length) >= 4) : Tcl_UtfCharComplete((src), (length)))
#   define TclChar16Complete Tcl_UtfCharComplete
    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 Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt 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 Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE long long TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#	define		TclpWideClicksToNanoseconds(clicks) \
				((double)(clicks) * TclpWideClickInMicrosec() * 1000)
#   endif
#endif
MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
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

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

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

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




︙


4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674

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

#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




︙


4697
4698
4699
4700
4701
4702
4703
4704

4705
4706
4707
4708
4709
4710
4711

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

#ifdef WORDS_BIGENDIAN
#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

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_PackageInitProc TclTommath_Init;
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_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;
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

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) = ((w) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideIntObj(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

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

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 */
/* 37 */
/* Slot 37 is reserved */
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 */
/* Slot 44 is reserved */
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 */




︙


186
187
188
189
190
191
192
193

194
195

196
197
198
199
200
201
202

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 Tcl_WideUInt	TclpGetClicks(void);
EXTERN unsigned long long TclpGetClicks(void);
/* 76 */
EXTERN Tcl_WideUInt	TclpGetSeconds(void);
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

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 */
/* 101 */
/* Slot 101 is reserved */
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 */




︙


501
502
503
504
505
506
507
508



509
510
511
512
513
514
515

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);
/* Slot 236 is reserved */
/* 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

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,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
				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

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		TclStaticPackage(Tcl_Interp *interp,
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
EXTERN void		TclStaticLibrary(Tcl_Interp *interp,
				const char *prefix,
				Tcl_LibraryInitProc *initProc,
				Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj);
/* 259 */
EXTERN void		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;





︙


625
626
627
628
629
630
631
632

633
634
635
636
637
638
639

640
641
642
643
644
645
646

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);
    int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */
    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);
    int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
    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

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 */
    Tcl_WideUInt (*tclpGetClicks) (void); /* 75 */
    Tcl_WideUInt (*tclpGetSeconds) (void); /* 76 */
    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

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);
    const char * (*tclSetPreInitScript) (const char *string); /* 101 */
    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

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 (*reserved236)(void);
    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, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    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 (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
    void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
    Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
    void (*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 */
    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

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 */
#define TclGetLoadedPackages \
/* Slot 37 is reserved */
	(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 \
/* Slot 44 is reserved */
	(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 */




︙


1012
1013
1014
1015
1016
1017
1018
1019
1020

1021
1022
1023
1024
1025
1026
1027

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 */
#define TclSetPreInitScript \
	(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
/* 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

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 \
/* Slot 236 is reserved */
	(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

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 TclStaticPackage \
	(tclIntStubsPtr->tclStaticPackage) /* 257 */
#define TclStaticLibrary \
	(tclIntStubsPtr->tclStaticLibrary) /* 257 */
#define TclpCreateTemporaryDirectory \
	(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
#define TclAppendUnicodeToObj \
	(tclIntStubsPtr->tclAppendUnicodeToObj) /* 259 */
#define TclGetBytesFromObj \
	(tclIntStubsPtr->tclGetBytesFromObj) /* 260 */
	(tclIntStubsPtr->tclGetBytesFromObj) /* 259 */

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

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 */
/* 0 */
/* Slot 0 is reserved */
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,
EXTERN void *		TclWinGetTclInstance(void);
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 5 */
EXTERN int		TclUnixWaitForFile_(int fd, int mask, int timeout);
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);
EXTERN size_t		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
EXTERN int		TclpCreatePipe_(TclFile *readPipe,
				TclFile *writePipe);
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj **attributePtrPtr);
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
EXTERN int		TclpIsAtty(int fd);
				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		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* Slot 18 is reserved */
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 */
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, size_t id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 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 */
/* 0 */
EXTERN void		TclWinConvertError(int errCode);
/* Slot 1 is reserved */
/* Slot 2 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 */
/* Slot 3 is reserved */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN void *		TclWinGetTclInstance(void);
/* 5 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* Slot 6 is reserved */
/* Slot 7 is reserved */
/* 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);
/* Slot 9 is reserved */
/* 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);
EXTERN int		TclpCloseFile_(TclFile file);
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
EXTERN Tcl_Channel	TclpCreateCommandChannel_(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 14 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
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);
EXTERN TclFile		TclpMakeFile_(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
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);
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 */
/* Slot 0 is reserved */
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,
EXTERN void *		TclWinGetTclInstance(void);
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 5 */
EXTERN int		TclUnixWaitForFile_(int fd, int mask, int timeout);
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);
EXTERN size_t		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
EXTERN int		TclpCreatePipe_(TclFile *readPipe,
				TclFile *writePipe);
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj **attributePtrPtr);
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
EXTERN int		TclpIsAtty(int fd);
				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		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* Slot 18 is reserved */
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 */
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, size_t id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 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 (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    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 */
    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 */
    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 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    void (*reserved10)(void);
    void (*reserved11)(void);
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    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 */
    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 (*reserved20)(void);
    void (*tclWinAddProcess) (void *hProcess, size_t id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
    void (*reserved23)(void);
    void (*reserved24)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(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 (*tclWinConvertError) (int errCode); /* 0 */
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*reserved3)(void);
    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 */
    void (*reserved6)(void);
    void (*reserved7)(void);
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    void (*reserved9)(void);
    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 (*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 */
    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 */
    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 */
    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 */
    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 */
    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 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    void (*reserved10)(void);
    void (*reserved11)(void);
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    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 */
    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 (*reserved20)(void);
    void (*tclWinAddProcess) (void *hProcess, size_t id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
    void (*reserved23)(void);
    void (*reserved24)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(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 */
#define TclGetAndDetachPids \
/* Slot 0 is reserved */
	(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 TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
/* 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 */
#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 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 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 TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
/* Slot 6 is reserved */
/* Slot 7 is reserved */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
/* Slot 9 is reserved */
#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 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 TclpMakeFile_ \
	(tclIntPlatStubsPtr->tclpMakeFile_) /* 18 */
#define TclpOpenFile_ \
	(tclIntPlatStubsPtr->tclpOpenFile_) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
#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 \
/* Slot 0 is reserved */
	(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 TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
/* 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 */
#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 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 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 TclWinConvertError
#define TclWinConvertWSAError Tcl_WinConvertError
#define TclWinConvertError Tcl_WinConvertError

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

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

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 --
 * 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 *
TclSetPreInitScript(
Tcl_SetPreInitScript(
    const char *string)		/* Pointer to a script. */
{
    const char *prevString = tclPreInitScript;
    tclPreInitScript = string;
    return(prevString);
    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

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);
		(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) TclGetStringFromObj(objv[i+1], &limitLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {




︙


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

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_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) TclGetStringFromObj(objv[i+1], &scriptLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &milliLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
		if (milliLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		if (TclGetWideIntFromObj(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));
		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;
		limitMoment.usec = ((long)tmp)*1000;
		break;
	    case OPT_SEC:
		secObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &secLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &secLen);
		if (secLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		if (TclGetWideIntFromObj(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));
		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 = tmp;
		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

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

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

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

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);
	value = Tcl_GetStringFromObj(valueObj, &valueLength);
	pp = (char **) linkPtr->addr;

	*pp = (char *)Tcl_Realloc(*pp, ++valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) TclGetStringFromObj(valueObj, &valueLength);
	value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength);
	valueLength++;		/* include end of string char */
	if (valueLength > linkPtr->bytes) {
	    return (char *) "wrong size of char* value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, valueLength);
	    memcpy(linkPtr->addr, value, valueLength);
	} else {
	    linkPtr->lastValue.c = '\0';
	    LinkedVar(char) = linkPtr->lastValue.c;
	}
	return NULL;

    case TCL_LINK_BINARY:
	value = (char *) TclGetByteArrayFromObj(valueObj, &valueLength);
	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

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

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

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

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

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

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

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

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

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);
	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 = TclGetStringFromObj(elemPtrs[i], &length);
	elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';
    }

    /* Set the string length to what was actually written, the safe choice */
    (void) Tcl_InitStringRep(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

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

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

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

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

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

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

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

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

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

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15

16
17


18
19


20
21



22
23
24
25

26


27
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 (c) 1995-1997 Sun Microsystems, Inc.
 * 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 package that has been loaded either
 * The following structure describes a library 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
 * to Tcl_StaticLibrary). All such libraries are linked together into a
 * single list for the process.
 * 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
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 *packageName;		/* Name of package prefix for the package,
    char *prefix;		/* Prefix for the library.
				 * 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;
    Tcl_LibraryInitProc *initProc;
				/* Initialization function to call to
				 * incorporate this package into a trusted
				 * incorporate this library into a trusted
				 * interpreter. */
    Tcl_PackageInitProc *safeInitProc;
    Tcl_LibraryInitProc *safeInitProc;
				/* Initialization function to call to
				 * incorporate this package into a safe
				 * incorporate this library into a safe
				 * interpreter (one that will execute
				 * untrusted scripts). NULL means the package
				 * untrusted scripts). NULL means the library
				 * can't be used in unsafe interpreters. */
    Tcl_PackageUnloadProc *unloadProc;
				/* Finalisation function to unload a package
    Tcl_LibraryUnloadProc *unloadProc;
				/* Finalization function to unload a library
				 * from a trusted interpreter. NULL means that
				 * the package cannot be unloaded. */
    Tcl_PackageUnloadProc *safeUnloadProc;
				/* Finalisation function to unload a package
				 * the library cannot be unloaded. */
    Tcl_LibraryUnloadProc *safeUnloadProc;
				/* Finalization function to unload a library
				 * from a safe interpreter. NULL means that
				 * the package cannot be unloaded. */
    int interpRefCount;		/* How many times the package has been loaded
				 * the library cannot be unloaded. */
    int interpRefCount;		/* How many times the library has been loaded
				 * in trusted interpreters. */
    int safeInterpRefCount;	/* How many times the package has been loaded
    int safeInterpRefCount;	/* How many times the library has been loaded
				 * in safe interpreters. */
    struct LoadedPackage *nextPtr;
				/* Next in list of all packages loaded into
    struct LoadedLibrary *nextPtr;
				/* Next in list of all libraries loaded into
				 * this application process. NULL means end of
				 * list. */
} LoadedPackage;
} LoadedLibrary;

/*
 * TCL_THREADS
 * There is a global list of packages that is anchored at firstPackagePtr.
 * There is a global list of libraries that is anchored at firstLibraryPtr.
 * Access to this list is governed by a mutex.
 */

static LoadedPackage *firstPackagePtr = NULL;
				/* First in list of all packages loaded into
static LoadedLibrary *firstLibraryPtr = NULL;
				/* First in list of all libraries loaded into
				 * this process. */

TCL_DECLARE_MUTEX(packageMutex)
TCL_DECLARE_MUTEX(libraryMutex)

/*
 * The following structure represents a particular package that has been
 * 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 package (if any).
 * first library (if any).
 */

typedef struct InterpPackage {
    LoadedPackage *pkgPtr;	/* Points to detailed information about
				 * package. */
    struct InterpPackage *nextPtr;
				/* Next package in this interpreter, or NULL
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. */
} InterpPackage;
} 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

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;
    LoadedPackage *pkgPtr, *defaultPtr;
    Tcl_DString pkgName, tmp, initName, safeInitName;
    LoadedLibrary *libraryPtr, *defaultPtr;
    Tcl_DString pfx, tmp, initName, safeInitName;
    Tcl_DString unloadName, safeUnloadName;
    InterpPackage *ipFirstPtr, *ipPtr;
    InterpLibrary *ipFirstPtr, *ipPtr;
    int code, namesMatch, filesMatch, offset;
    const char *symbols[2];
    Tcl_PackageInitProc *initProc;
    const char *p, *fullFileName, *packageName;
    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

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 ?packageName? ?interp?");
	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(&pkgName);
    Tcl_DStringInit(&pfx);
    Tcl_DStringInit(&initName);
    Tcl_DStringInit(&safeInitName);
    Tcl_DStringInit(&unloadName);
    Tcl_DStringInit(&safeUnloadName);
    Tcl_DStringInit(&tmp);

    packageName = NULL;
    prefix = NULL;
    if (objc >= 3) {
	packageName = TclGetString(objv[2]);
	if (packageName[0] == '\0') {
	    packageName = NULL;
	prefix = TclGetString(objv[2]);
	if (prefix[0] == '\0') {
	    prefix = NULL;
	}
    }
    if ((fullFileName[0] == 0) && (packageName == NULL)) {
    if ((fullFileName[0] == 0) && (prefix == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must specify either file name or package name", -1));
		"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 package into.
     * 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 packages that are currently loaded to see if the
     * package we want is already loaded. We'll use a loaded package if it
     * 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 package with the same name.
     *	  only no statically loaded library with the same prefix.
     */

    Tcl_MutexLock(&packageMutex);
    Tcl_MutexLock(&libraryMutex);

    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	if (packageName == NULL) {
    for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
	if (prefix == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&pfx);
	    Tcl_DStringAppend(&pfx, prefix, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		    Tcl_DStringValue(&pfx)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);
	TclDStringClear(&pfx);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (prefix == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;
	    defaultPtr = libraryPtr;
	}
	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
	    /*
	     * Can't have two different packages loaded from the same file.
	     * Can't have two different libraries loaded from the same file.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "file \"%s\" is already loaded for package \"%s\"",
		    fullFileName, pkgPtr->packageName));
		    "file \"%s\" is already loaded for prefix \"%s\"",
		    fullFileName, libraryPtr->prefix));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
		    "SPLITPERSONALITY", NULL);
	    code = TCL_ERROR;
	    Tcl_MutexUnlock(&packageMutex);
	    Tcl_MutexUnlock(&libraryMutex);
	    goto done;
	}
    }
    Tcl_MutexUnlock(&packageMutex);
    if (pkgPtr == NULL) {
	pkgPtr = defaultPtr;
    Tcl_MutexUnlock(&libraryMutex);
    if (libraryPtr == NULL) {
	libraryPtr = defaultPtr;
    }

    /*
     * Scan through the list of packages already loaded in the target
     * interpreter. If the package we want is already loaded there, then
     * 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 (pkgPtr != NULL) {
	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
    if (libraryPtr != NULL) {
	ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
	    if (ipPtr->libraryPtr == libraryPtr) {
		code = TCL_OK;
		goto done;
	    }
	}
    }

    if (pkgPtr == NULL) {
    if (libraryPtr == NULL) {
	/*
	 * The desired file isn't currently loaded, so load it. It's an error
	 * if the desired package is a static one.
	 * if the desired library is a static one.
	 */

	if (fullFileName[0] == 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "package \"%s\" isn't loaded statically", packageName));
		    "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 module name if it wasn't provided explicitly.
	 * Figure out the prefix if it wasn't provided explicitly.
	 */

	if (packageName != NULL) {
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	if (prefix != NULL) {
	    Tcl_DStringAppend(&pfx, prefix, -1);
	} else {
	    Tcl_Obj *splitPtr, *pkgGuessPtr;
	    int retc;
	    int pElements;
	    const char *pkgGuess;

	    /*
	     * 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.
		 */
	    /*
	     * 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;
		}
	    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;
		}
	    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);
	    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);
	    }
		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 package name so that the first
	 * character is in caps (or title case) but the others are all
	 * lower-case.
	 */
	    /*
	     * 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(&pkgName,
		Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
	    Tcl_DStringSetLength(&pfx,
		    Tcl_UtfToTitle(Tcl_DStringValue(&pfx)));

	}

	/*
	 * Compute the names of the two initialization functions, based on the
	 * package name.
	 * prefix.
	 */

	TclDStringAppendDString(&initName, &pkgName);
	TclDStringAppendDString(&initName, &pfx);
	TclDStringAppendLiteral(&initName, "_Init");
	TclDStringAppendDString(&safeInitName, &pkgName);
	TclDStringAppendDString(&safeInitName, &pfx);
	TclDStringAppendLiteral(&safeInitName, "_SafeInit");
	TclDStringAppendDString(&unloadName, &pkgName);
	TclDStringAppendDString(&unloadName, &pfx);
	TclDStringAppendLiteral(&unloadName, "_Unload");
	TclDStringAppendDString(&safeUnloadName, &pkgName);
	TclDStringAppendDString(&safeUnloadName, &pfx);
	TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");

	/*
	 * Call platform-specific code to load the package and find the two
	 * Call platform-specific code to load the library and find the two
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);
	symbols[1] = NULL;

	Tcl_MutexLock(&packageMutex);
	Tcl_MutexLock(&libraryMutex);
	code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc,
		&loadHandle);
	Tcl_MutexUnlock(&packageMutex);
	Tcl_MutexUnlock(&libraryMutex);
	if (code != TCL_OK) {
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 * Create a new record to describe this library.
	 */

	pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
	libraryPtr = (LoadedLibrary *)Tcl_Alloc(sizeof(LoadedLibrary));
	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 *)
	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));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)
	libraryPtr->unloadProc	   = (Tcl_LibraryUnloadProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&unloadName));
	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc *)
	libraryPtr->safeUnloadProc	   = (Tcl_LibraryUnloadProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeUnloadName));
	pkgPtr->interpRefCount	   = 0;
	pkgPtr->safeInterpRefCount = 0;
	libraryPtr->interpRefCount	   = 0;
	libraryPtr->safeInterpRefCount = 0;

	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		   = firstPackagePtr;
	firstPackagePtr		   = pkgPtr;
	Tcl_MutexUnlock(&packageMutex);
	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 package's initialization function (either the normal one or
     * 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 (pkgPtr->safeInitProc == NULL) {
	if (libraryPtr->safeInitProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't use package in a safe interpreter: no"
		    " %s_SafeInit procedure", pkgPtr->packageName));
		    "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 = pkgPtr->safeInitProc(target);
	code = libraryPtr->safeInitProc(target);
    } else {
	if (pkgPtr->initProc == NULL) {
	if (libraryPtr->initProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't attach package to interpreter: no %s_Init procedure",
		    pkgPtr->packageName));
		    "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 = pkgPtr->initProc(target);
	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

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 package has been loaded in the target
     * Record the fact that the library has been loaded in the target
     * interpreter.
     *
     * Update the proper reference count.
     */

    Tcl_MutexLock(&packageMutex);
    Tcl_MutexLock(&libraryMutex);
    if (Tcl_IsSafe(target)) {
	pkgPtr->safeInterpRefCount++;
	libraryPtr->safeInterpRefCount++;
    } else {
	pkgPtr->interpRefCount++;
	libraryPtr->interpRefCount++;
    }
    Tcl_MutexUnlock(&packageMutex);
    Tcl_MutexUnlock(&libraryMutex);

    /*
     * Refetch ipFirstPtr: loading the package may have introduced additional
     * static packages at the head of the linked list!
     * Refetch ipFirstPtr: loading the library may have introduced additional
     * static libraries at the head of the linked list!
     */

    ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
    ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
    ipPtr->pkgPtr = pkgPtr;
    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(&pkgName);
    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

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. */
    LoadedPackage *pkgPtr, *defaultPtr;
    Tcl_DString pkgName, tmp;
    Tcl_PackageUnloadProc *unloadProc;
    InterpPackage *ipFirstPtr, *ipPtr;
    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 *packageName;
    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

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 ?packageName? ?interp?");
		"?-switch ...? fileName ?prefix? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	return TCL_ERROR;
    }

    fullFileName = TclGetString(objv[i]);
    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&pfx);
    Tcl_DStringInit(&tmp);

    packageName = NULL;
    prefix = NULL;
    if (objc - i >= 2) {
	packageName = TclGetString(objv[i+1]);
	if (packageName[0] == '\0') {
	    packageName = NULL;
	prefix = TclGetString(objv[i+1]);
	if (prefix[0] == '\0') {
	    prefix = NULL;
	}
    }
    if ((fullFileName[0] == 0) && (packageName == NULL)) {
    if ((fullFileName[0] == 0) && (prefix == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must specify either file name or package name", -1));
		"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 package into.
     * 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 packages that are currently loaded to see if the
     * package we want is already loaded. We'll use a loaded package if it
     * 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 package with the same name.
     *  - 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(&packageMutex);
    Tcl_MutexLock(&libraryMutex);

    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
    for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
	int namesMatch, filesMatch;

	if (packageName == NULL) {
	if (prefix == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&pfx);
	    Tcl_DStringAppend(&pfx, prefix, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		    Tcl_DStringValue(&pfx)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);
	TclDStringClear(&pfx);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (prefix == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;
	    defaultPtr = libraryPtr;
	}
	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
	    break;
	}
    }
    Tcl_MutexUnlock(&packageMutex);
    Tcl_MutexUnlock(&libraryMutex);
    if (fullFileName[0] == 0) {
	/*
	 * It's an error to try unload a static package.
	 * It's an error to try unload a static library.
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"package \"%s\" is loaded statically and cannot be unloaded",
		packageName));
		"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 (pkgPtr == NULL) {
    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 packages already loaded in the target
     * interpreter. If the package we want is already loaded there, then we
     * 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 (pkgPtr != NULL) {
	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
    if (libraryPtr != NULL) {
	ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
	    if (ipPtr->libraryPtr == libraryPtr) {
		code = TCL_OK;
		break;
	    }
	}
    }
    if (code != TCL_OK) {
	/*
	 * The package has not been loaded in this interpreter.
	 * 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,
     * 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.
     * 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 (pkgPtr->safeUnloadProc == NULL) {
	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 = pkgPtr->safeUnloadProc;
	unloadProc = libraryPtr->safeUnloadProc;
    } else {
	if (pkgPtr->unloadProc == NULL) {
	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 = pkgPtr->unloadProc;
	unloadProc = libraryPtr->unloadProc;
    }

    /*
     * We are ready to unload the package. First, evaluate the unload
     * 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(&packageMutex);
	trustedRefCount = pkgPtr->interpRefCount;
	safeRefCount = pkgPtr->safeInterpRefCount;
	Tcl_MutexUnlock(&packageMutex);
	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

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(&packageMutex);
    Tcl_MutexLock(&libraryMutex);
    if (Tcl_IsSafe(target)) {
	pkgPtr->safeInterpRefCount--;
	libraryPtr->safeInterpRefCount--;

	/*
	 * Do not let counter get negative.
	 */

	if (pkgPtr->safeInterpRefCount < 0) {
	    pkgPtr->safeInterpRefCount = 0;
	if (libraryPtr->safeInterpRefCount < 0) {
	    libraryPtr->safeInterpRefCount = 0;
	}
    } else {
	pkgPtr->interpRefCount--;
	libraryPtr->interpRefCount--;

	/*
	 * Do not let counter get negative.
	 */

	if (pkgPtr->interpRefCount < 0) {
	    pkgPtr->interpRefCount = 0;
	if (libraryPtr->interpRefCount < 0) {
	    libraryPtr->interpRefCount = 0;
	}
    }
    trustedRefCount = pkgPtr->interpRefCount;
    safeRefCount = pkgPtr->safeInterpRefCount;
    Tcl_MutexUnlock(&packageMutex);
    trustedRefCount = libraryPtr->interpRefCount;
    safeRefCount = libraryPtr->safeInterpRefCount;
    Tcl_MutexUnlock(&libraryMutex);

    code = TCL_OK;
    if (pkgPtr->safeInterpRefCount <= 0 && pkgPtr->interpRefCount <= 0
    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 (pkgPtr->fileName[0] != '\0') {
	    Tcl_MutexLock(&packageMutex);
	    if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
	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 = pkgPtr;
		if (defaultPtr == firstPackagePtr) {
		    firstPackagePtr = pkgPtr->nextPtr;
		defaultPtr = libraryPtr;
		if (defaultPtr == firstLibraryPtr) {
		    firstLibraryPtr = libraryPtr->nextPtr;
		} else {
		    for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
			    pkgPtr = pkgPtr->nextPtr) {
			if (pkgPtr->nextPtr == defaultPtr) {
			    pkgPtr->nextPtr = defaultPtr->nextPtr;
		    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 = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
		ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
		ipPtr = ipFirstPtr;
		if (ipPtr->pkgPtr == defaultPtr) {
		if (ipPtr->libraryPtr == defaultPtr) {
		    ipFirstPtr = ipFirstPtr->nextPtr;
		} else {
		    InterpPackage *ipPrevPtr;
		    InterpLibrary *ipPrevPtr;

		    for (ipPrevPtr = ipPtr; ipPtr != NULL;
			    ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
			if (ipPtr->pkgPtr == defaultPtr) {
			if (ipPtr->libraryPtr == defaultPtr) {
			    ipPrevPtr->nextPtr = ipPtr->nextPtr;
			    break;
			}
		    }
		}
		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
			ipFirstPtr);
		Tcl_Free(defaultPtr->fileName);
		Tcl_Free(defaultPtr->packageName);
		Tcl_Free(defaultPtr->prefix);
		Tcl_Free(defaultPtr);
		Tcl_Free(ipPtr);
		Tcl_MutexUnlock(&packageMutex);
		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(&pkgName);
    Tcl_DStringFree(&pfx);
    Tcl_DStringFree(&tmp);
    if (!complain && (code != TCL_OK)) {
	code = TCL_OK;
	Tcl_ResetResult(interp);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StaticPackage --
 * Tcl_StaticLibrary --
 *
 *	This function is invoked to indicate that a particular package has
 *	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 package becomes loadable via the
 *	Once this function completes, the library 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
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 *pkgName,	/* Name of package (must be properly
    const char *prefix,	/* Prefix. */
				 * capitalized: first letter upper case,
				 * others lower case). */
    Tcl_PackageInitProc *initProc,
    Tcl_LibraryInitProc *initProc,
				/* Function to call to incorporate this
				 * package into a trusted interpreter. */
    Tcl_PackageInitProc *safeInitProc)
				 * library into a trusted interpreter. */
    Tcl_LibraryInitProc *safeInitProc)
				/* Function to call to incorporate this
				 * package into a safe interpreter (one that
				 * library into a safe interpreter (one that
				 * will execute untrusted scripts). NULL means
				 * the package can't be used in safe
				 * the library can't be used in safe
				 * interpreters. */
{
    LoadedPackage *pkgPtr;
    InterpPackage *ipPtr, *ipFirstPtr;
    LoadedLibrary *libraryPtr;
    InterpLibrary *ipPtr, *ipFirstPtr;

    /*
     * Check to see if someone else has already reported this package as
     * Check to see if someone else has already reported this library 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)) {
    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(&packageMutex);
    Tcl_MutexUnlock(&libraryMutex);

    /*
     * If the package is not yet recorded as being loaded statically, add it
     * If the library 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 (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 package into an interpreter, determine whether
	 * If we're loading the library into an interpreter, determine whether
	 * it's already loaded.
	 */

	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(interp, "tclLoad", NULL);
	ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(interp, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
	    if (ipPtr->libraryPtr == libraryPtr) {
		return;
	    }
	}

	/*
	 * Package isn't loaded in the current interp yet. Mark it as now being
	 * Library isn't loaded in the current interp yet. Mark it as now being
	 * loaded.
	 */

	ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
	ipPtr->pkgPtr = pkgPtr;
	ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary));
	ipPtr->libraryPtr = libraryPtr;
	ipPtr->nextPtr = ipFirstPtr;
	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetLoadedPackages, TclGetLoadedPackagesEx --
 * 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 name of the package in that file.
 *	the second element is the prefix of the library in that file.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGetLoadedPackages(
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. */
{
    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.
    const char *prefix)	/* Prefix or NULL. If NULL, return info
				 * for all prefixes.
				 */
{
    Tcl_Interp *target;
    LoadedPackage *pkgPtr;
    InterpPackage *ipPtr;
    LoadedLibrary *libraryPtr;
    InterpLibrary *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_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(&packageMutex);
	Tcl_MutexUnlock(&libraryMutex);
	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);
    ipPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);

    /*
     * Return information about all of the available packages.
     * Return information about all of the available libraries.
     */
    if (packageName) {
    if (prefix) {
	resultObj = NULL;

	for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    pkgPtr = ipPtr->pkgPtr;
	    libraryPtr = ipPtr->libraryPtr;

	    if (!strcmp(packageName, pkgPtr->packageName)) {
		resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1);
	    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 packages that are loaded in a given
     * Return information about only the libraries 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);
	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 InterpPackage structures
 *	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 InterpPackage functions for interp get deleted.
 *	Storage for all of the InterpLibrary functions for interp get deleted.
 *
 *----------------------------------------------------------------------
 */

static void
LoadCleanupProc(
    ClientData clientData,	/* Pointer to first InterpPackage structure
    ClientData clientData,	/* Pointer to first InterpLibrary structure
				 * for interp. */
    TCL_UNUSED(Tcl_Interp *))
{
    InterpPackage *ipPtr, *nextPtr;
    InterpLibrary *ipPtr, *nextPtr;

    ipPtr = (InterpPackage *)clientData;
    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 LoadedPackage structures.
 *	all of the LoadedLibrary structures.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeLoad(void)
{
    LoadedPackage *pkgPtr;
    LoadedLibrary *libraryPtr;

    /*
     * No synchronization here because there should just be one thread alive
     * at this point. Logically, packageMutex should be grabbed at this point,
     * 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 (firstPackagePtr != NULL) {
	pkgPtr = firstPackagePtr;
	firstPackagePtr = pkgPtr->nextPtr;
    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 (pkgPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
	if (libraryPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFile(NULL, libraryPtr->loadHandle);
	}
#endif

	Tcl_Free(pkgPtr->fileName);
	Tcl_Free(pkgPtr->packageName);
	Tcl_Free(pkgPtr);
	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

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

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;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 */
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(int))
{
    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,
    TCL_UNUSED(void *),
    TCL_UNUSED(int),
    TCL_UNUSED(int),
    TCL_UNUSED(Tcl_LoadHandle *),
    TCL_UNUSED(Tcl_FSUnloadFileProc **),
				/* Dummy: unused by this implementation */
    int flags)
    TCL_UNUSED(int))
				/* 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;
}




︙







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

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

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

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




︙


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

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)TclGetStringFromObj(is.commandPtr, &length);
	    (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)TclGetStringFromObj(resultPtr, &length);
		(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

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

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

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

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

1
2
3
4
5
6
7
8
9



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 (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
 * 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"

/*
 * Module-scope struct of notifier hooks that are checked in the default
 * Notifier hooks that are checked in the public wrappers for the default
 * notifier functions (for overriding via Tcl_SetNotifier).
 */

Tcl_NotifierProcs tclNotifierHooks = {
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

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

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

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

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

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

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

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

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
    return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
    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

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

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

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

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

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

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

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

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

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

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

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

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

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

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);
    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 = TclGetStringFromObj(privateVar->variableObj, &len);
	    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 = TclGetStringFromObj(variableObj, &len);
	    match = Tcl_GetStringFromObj(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);
	    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 = TclGetStringFromObj(variableObj, &len);
	    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

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);
	    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 = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr),
    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

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

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

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 = "TclOO";
    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;
	    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

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

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

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

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

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

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 = TclGetStringFromObj(objPtr, &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 = TclGetStringFromObj(objPtr, &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

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

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;
    const char *string = TclGetString(objPtr);
    size_t length = objPtr->length;
    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

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

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);
		(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) TclGetStringFromObj(litPtr, &numBytes);
		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;

	case INST_LNOT:




︙







Changes to generic/tclPanic.c.



1
2
3
4
5
6
7
8
9
10



11
12
13
14
15
16
17

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

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
const char *
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{
    panicProc = proc;
    Tcl_InitSubsystems();
    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

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

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

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 '\' */
	    count = TclUtfToUCS4(p, &unichar) + 1;	/* +1 for '\' */
	} else {
	    char utfBytes[4];
	    char utfBytes[8];

	    memcpy(utfBytes, p, numBytes - 1);
	    utfBytes[numBytes - 1] = '\0';
	    count = TclUtfToUniChar(utfBytes, &unichar) + 1;
	    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

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

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

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

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

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

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);
				    Tcl_GetStringFromObj(retVal, &curLen);

			    while (curLen-- > 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

			    /*
			     * We want the trailing slash.
			     */

			    Tcl_SetObjLength(retVal, curLen+1);
			    Tcl_AppendObjToObj(retVal, linkObj);
			    TclDecrRefCount(linkObj);
			    linkStr = TclGetStringFromObj(retVal, &curLen);
			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
			} else {
			    /*
			     * Absolute link.
			     */

			    TclDecrRefCount(retVal);
			    if (Tcl_IsShared(linkObj)) {
				retVal = Tcl_DuplicateObj(linkObj);
				TclDecrRefCount(linkObj);
			    } else {
				retVal = linkObj;
			    }
			    linkStr = TclGetStringFromObj(retVal, &curLen);
			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);

			    /*
			     * Convert to forward-slashes on windows.
			     */

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				size_t i;

				for (i = 0; i < curLen; i++) {
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
			}
		    } else {
			linkStr = TclGetStringFromObj(retVal, &curLen);
			linkStr = Tcl_GetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the path).
		     */





︙


381
382
383
384
385
386
387
388

389
390
391
392
393
394
395

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

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

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

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

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

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

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

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

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

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

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);
    tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);

    /*
     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
     * Windows special case? Perhaps we should just check if cwd is a root
     * volume.
     */

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	if (tempStr[cwdLen-1] != '/') {
	    cwdLen++;
	}
	break;
    case TCL_PLATFORM_WINDOWS:
	if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') {
	    cwdLen++;
	}
	break;
    }
    tempStr = TclGetStringFromObj(pathPtr, &len);
    tempStr = Tcl_GetStringFromObj(pathPtr, &len);

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}

/*
 *---------------------------------------------------------------------------
 *




︙


1653
1654
1655
1656
1657
1658
1659
1660

1661
1662
1663
1664
1665
1666
1667

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

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);
	(void)Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);

	/*
	 * We now own a reference on both 'dir' and 'copy'
	 */

	(void) TclGetStringFromObj(dir, &cwdLen);
	(void) Tcl_GetStringFromObj(dir, &cwdLen);

	/* Normalize the combined string. */

	if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
	    /*
	     * If the "tail" part has components (like /../) that cause the
	     * combined path to need more complete normalizing, call on the




︙


1809
1810
1811
1812
1813
1814
1815
1816

1817
1818
1819
1820
1821
1822
1823

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

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);
    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
    if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) {
	return 1;
    }

    /*
     * Try the most thorough, correct method of comparing fully normalized
     * paths.
     */

    tempErrno = Tcl_GetErrno();
    firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
    secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
    Tcl_SetErrno(tempErrno);

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;
    }

    firstStr = TclGetStringFromObj(firstPtr, &firstLen);
    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
    return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen));
}

/*
 *---------------------------------------------------------------------------
 *
 * SetFsPathFromAny --




︙


2221
2222
2223
2224
2225
2226
2227
2228

2229
2230
2231
2232
2233
2234
2235

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

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

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

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

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

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

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);
	    argv4 = Tcl_GetStringFromObj(iPtr->scriptFile, &length);
	    DupBlock(availPtr->pkgIndex, argv4, length + 1);
	}
	argv4 = TclGetStringFromObj(objv[4], &length);
	argv4 = Tcl_GetStringFromObj(objv[4], &length);
	DupBlock(availPtr->script, argv4, length + 1);
	break;
    }
    case PKG_NAMES:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;




︙


1405
1406
1407
1408
1409
1410
1411
1412

1413
1414
1415
1416
1417
1418
1419

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

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

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.
 *	library.
 *
 * Copyright (c) 2002 Andreas Kupries <[email protected]>
 * 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

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},
    {"zipfile,runtime",		CFG_RUNTIME_ZIPFILE},
#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

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

#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 */
/* 2 */
EXTERN void		Tcl_MacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 3 */
EXTERN void		Tcl_WinConvertError(unsigned errCode);

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 */
    void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
#endif /* MACOSX */
    void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
} 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 */
#define Tcl_MacOSXNotifierAddRunLoopMode \
	(tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */
#define Tcl_WinConvertError \
#endif /* MACOSX */
	(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 MAC_OSX_TCL /* MACOSX */
#undef Tcl_MacOSXOpenBundleResources
#ifdef _WIN32
#   undef Tcl_CreateFileHandler
#   undef Tcl_DeleteFileHandler
#   undef Tcl_GetOpenFile
#define Tcl_MacOSXOpenBundleResources(a,b,c,d,e) Tcl_MacOSXOpenVersionedBundleResources(a,b,NULL,c,d,e)
#endif

#undef TCL_STORAGE_CLASS
#ifndef MAC_OSX_TCL
#   undef Tcl_MacOSXOpenVersionedBundleResources
#   undef Tcl_MacOSXNotifierAddRunLoopMode
#define TCL_STORAGE_CLASS DLLIMPORT
#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

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

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

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

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

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

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

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

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

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

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

1
2
3
4
5
6


7
8
9
10
11
12
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.
 * 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 (c) 1998 Henry Spencer.  All rights reserved.
 * 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

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

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

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

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

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

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

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

1
2
3
4
5
6
7
8
9

10
11
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 (c) 2005 by Kevin B. Kenny. All rights reserved.
 * 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

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	((Tcl_WideUInt)-1)
#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

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 >
					((Tcl_WideUInt)-1 >> shift)))) {
					(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

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 > ((Tcl_WideUInt)-1 >> shift))) {
			    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

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 == '_' && !(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 > ((Tcl_WideUInt)-1 >> shift))) {
			    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

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

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 > ((Tcl_WideUInt)-1-digit)/pow10_wide[numZeros+1]) {
		|| 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

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 *= 10.0;
	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 -= 5.;
	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

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;
	Tcl_WideUInt iv;
	uint64_t 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);
    if (bitwhack.iv & (UINT64_C(1) << 63)) {
	bitwhack.iv &= ~ (UINT64_C(1) << 63);
	*buffer++ = '-';
    }
    *buffer++ = 'N';
    *buffer++ = 'a';
    *buffer++ = 'N';
    bitwhack.iv &= (((Tcl_WideUInt) 1) << 51) - 1;
    bitwhack.iv &= ((UINT64_C(1)) << 51) - 1;
    if (bitwhack.iv != 0) {
	sprintf(buffer, "(%" TCL_LL_MODIFIER "x)", bitwhack.iv);
	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

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

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

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) TclGetByteArrayFromObj(objPtr, &numChars);
	(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

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 = TclGetByteArrayFromObj(objPtr, &length);
	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

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 --
 * 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. */
    int *lengthPtr)		/* If non-NULL, the location where the string
    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

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 = TclGetByteArrayFromObj(objPtr, &length);
	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

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 = TclUtfPrev(ellipsis+eLen, ellipsis) - ellipsis;
	    eLen = Tcl_UtfPrev(ellipsis+eLen, ellipsis) - ellipsis;
	}

	toCopy = TclUtfPrev(bytes+limit+1-eLen, bytes) - bytes;
	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

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 -1, then append all bytes up to NUL
				 * 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

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) TclGetByteArrayFromObj(objPtr, &length);
	(void) TclGetByteArrayFromObj(appendObjPtr, &lengthSrc);
	(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,
		Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
		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 =
		    TclGetUnicodeFromObj(appendObjPtr, &numChars);
		    Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);

	    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
	} else {
	    bytes = TclGetStringFromObj(appendObjPtr, &length);
	    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
	    AppendUtfToUnicodeRep(objPtr, bytes, length);
	}
	return;
    }

    /*
     * Append to objPtr's UTF string rep. If we know the number of characters
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = TclGetStringFromObj(appendObjPtr, &length);
    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars != 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

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)TclGetStringFromObj(appendObj, &originalLength);
    (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

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

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)TclGetStringFromObj(segment, &segmentNumBytes);
	(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

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 = TclUtfPrev(end, bytes);
		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

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 TclGetStringFromObj(objPtr, sizePtr);
	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

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)TclGetByteArrayFromObj(objPtr, &length);
	(void)Tcl_GetByteArrayFromObj(objPtr, &length);
    } else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	(void)TclGetUnicodeFromObj(objPtr, &length);
	(void)Tcl_GetUnicodeFromObj(objPtr, &length);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	(void)TclGetStringFromObj(objPtr, &length);
	(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

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,
		Tcl_GetByteArrayFromObj(objResultPtr, NULL),
		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

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

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;
		if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
	 	} 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

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)TclGetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */
		(void)Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */

		if (numBytes) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    }
		    length += numBytes;
		}
	    }
	} while (--oc);
    } else if (allowUniChar && requestUniChar) {
    } 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)TclGetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
		(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

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)TclGetStringFromObj(objPtr, &length); /* PANIC? */
		    (void)Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */
		}
	    } while (--oc && (length == 0) && (pendingPtr == NULL));

	    /*
 	     * Either we found a possibly non-empty value, and we remember
 	     * this index as the first and last such value so far seen,
	     * or (oc == 0) and all values are known empty,




︙


3050
3051
3052
3053
3054
3055
3056
3057

3058
3059
3060
3061
3062
3063
3064

3065
3066
3067
3068
3069
3070
3071

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)TclGetStringFromObj(objPtr, &numBytes); /* PANIC? */
		    (void)Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */
		} while (--oc && numBytes == 0 && pendingPtr->bytes == NULL);

		if (numBytes) {
		    last = objc -oc -1;
		}
		if (oc || numBytes) {
		    (void)TclGetStringFromObj(pendingPtr, &length);
		    (void)Tcl_GetStringFromObj(pendingPtr, &length);
		}
		if (length == 0) {
		    if (numBytes) {
			first = last;
		    }
		} else if (numBytes + 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

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)TclGetByteArrayFromObj(objResultPtr, &start);
	    (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 = TclGetByteArrayFromObj(objPtr, &more);
		unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, more);
		dst += more;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
    } 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)TclGetUnicodeFromObj(objResultPtr, &start);
	    (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

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 = TclGetUnicodeFromObj(objPtr, &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)TclGetStringFromObj(objResultPtr, &start);
	    (void)Tcl_GetStringFromObj(objResultPtr, &start);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_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

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 = TclGetStringFromObj(objPtr, &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

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 *) TclGetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) TclGetByteArrayFromObj(value2Ptr, &s2len);
	    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 *) TclGetUnicodeFromObj(value1Ptr, &s1len);
		s2 = (char *) TclGetUnicodeFromObj(value2Ptr, &s2len);
		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 (
#ifdef WORDS_BIGENDIAN
#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 = TclGetStringFromObj(value2Ptr, &s2len);
		    s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
		    break;
		case 0:
		    match = -1;
		    goto matchdone;
		case 1:
		default: /* avoid warn: `s2` may be used uninitialized */
		    match = 0;
		    goto matchdone;
		}
	    } else if (TclCheckEmptyString(value2Ptr) > 0) {
		switch (empty) {
		case -1:
		    s2 = 0;
		    s2len = 0;
		    s1 = TclGetStringFromObj(value1Ptr, &s1len);
		    s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
		    break;
		case 0:
		    match = 1;
		    goto matchdone;
		case 1:
		default: /* avoid warn: `s1` may be used uninitialized */
		    match = 0;
		    goto matchdone;
		}
	    } else {
		s1 = TclGetStringFromObj(value1Ptr, &s1len);
		s2 = TclGetStringFromObj(value2Ptr, &s2len);
		s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
		s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
	    }
	    if (!nocase && checkEq) {
		/*
		 * 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

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 = TclGetByteArrayFromObj(needle, &ln);
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	/* Find bytes in bytes */
	bh = TclGetByteArrayFromObj(haystack, &lh);
	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

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 = TclGetUnicodeFromObj(needle, &ln);
    uh = TclGetUnicodeFromObj(haystack, &lh);
    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

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 = TclGetByteArrayFromObj(haystack, &lh);
	unsigned char *bn = TclGetByteArrayFromObj(needle, &ln);
	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

3643
3644
3645
3646
3647
3648
3649


3650
3651
3652
3653
3654
3655
3656
3657
3658








-
-
+
+








		goto lastEnd;
	    }
	    check--;
	}
	goto lastEnd;
    }

    uh = TclGetUnicodeFromObj(haystack, &lh);
    un = TclGetUnicodeFromObj(needle, &ln);
    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

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 = TclGetByteArrayFromObj(objPtr, &numBytes);
	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, 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;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    Tcl_UniChar *to;
	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

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 charCount = 0;
	    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 = TclUtfToUniChar(from, &ch);
		size_t bytesInChar = TclUtfToUCS4(from, &chw);

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




︙


3825
3826
3827
3828
3829
3830
3831
3832

3833
3834
3835
3836
3837
3838
3839

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 = TclGetByteArrayFromObj(objPtr, &numBytes);
	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

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
		    = TclGetByteArrayFromObj(insertPtr, &newBytes);
		    = 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

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 = TclGetUnicodeFromObj(objPtr, &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

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;
    }
    for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
    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;
	*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

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.
 * Copyright © 1998-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

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 TclStaticPackage
#undef TclStaticLibrary
#undef Tcl_BackgroundError
#define TclStaticPackage Tcl_StaticPackage
#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 *, int *))(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

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_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_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_s_mp_balance_mul mp_balance_mul
#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 TclUnixWaitForFile_ TclUnixWaitForFile
#define TclpMakeFile_ TclpMakeFile
#define TclpOpenFile_ TclpOpenFile
#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 Tcl_MacOSXOpenVersionedBundleResources 0
#   define Tcl_MacOSXNotifierAddRunLoopMode 0
#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
#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

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

#endif /* __CYGWIN__ */
#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

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 */
    TclGetLoadedPackages, /* 37 */
    0, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
    TclpGetUserHome, /* 42 */
    0, /* 43 */
    TclGuessPackageName, /* 44 */
    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

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 */
    TclSetPreInitScript, /* 101 */
    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

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 */
    0, /* 236 */
    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 */
    TclStaticPackage, /* 257 */
    TclStaticLibrary, /* 257 */
    TclpCreateTemporaryDirectory, /* 258 */
    TclAppendUnicodeToObj, /* 259 */
    TclGetBytesFromObj, /* 260 */
    TclGetBytesFromObj, /* 259 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclGetAndDetachPids, /* 0 */
    0, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    TclUnixWaitForFile_, /* 5 */
    TclWinGetTclInstance, /* 4 */
    TclUnixWaitForFile, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpGetPid, /* 8 */
    TclpCreateTempFile, /* 9 */
    0, /* 10 */
    0, /* 11 */
    TclGetAndDetachPids, /* 11 */
    0, /* 12 */
    0, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclpCreatePipe_, /* 14 */
    TclpCreateProcess, /* 15 */
    TclpIsAtty, /* 16 */
    TclUnixCopyFile, /* 17 */
    0, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    0, /* 20 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile_, /* 22 */
    0, /* 23 */
    0, /* 24 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    0, /* 26 */
    0, /* 27 */
    TclWinFlushDirtyChannels, /* 27 */
    0, /* 28 */
    TclWinCPUID, /* 29 */
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    TclWinConvertError, /* 0 */
    0, /* 1 */
    0, /* 2 */
    0, /* 3 */
    0, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclWinGetTclInstance, /* 4 */
    TclUnixWaitForFile, /* 5 */
    0, /* 6 */
    0, /* 7 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclpGetPid, /* 8 */
    0, /* 9 */
    TclpCreateTempFile, /* 9 */
    0, /* 10 */
    TclGetAndDetachPids, /* 11 */
    TclpCloseFile, /* 12 */
    TclpCreateCommandChannel, /* 13 */
    TclpCreatePipe, /* 14 */
    TclpCloseFile_, /* 12 */
    TclpCreateCommandChannel_, /* 13 */
    TclpCreatePipe_, /* 14 */
    TclpCreateProcess, /* 15 */
    TclpIsAtty, /* 16 */
    TclUnixCopyFile, /* 17 */
    TclpMakeFile, /* 18 */
    TclpOpenFile, /* 19 */
    TclpMakeFile_, /* 18 */
    TclpOpenFile_, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile, /* 22 */
    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 */
    0, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    TclUnixWaitForFile_, /* 5 */
    TclWinGetTclInstance, /* 4 */
    TclUnixWaitForFile, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpGetPid, /* 8 */
    TclpCreateTempFile, /* 9 */
    0, /* 10 */
    0, /* 11 */
    TclGetAndDetachPids, /* 11 */
    0, /* 12 */
    0, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclpCreatePipe_, /* 14 */
    TclpCreateProcess, /* 15 */
    TclpIsAtty, /* 16 */
    TclUnixCopyFile, /* 17 */
    0, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    0, /* 20 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile_, /* 22 */
    0, /* 23 */
    0, /* 24 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    0, /* 26 */
    0, /* 27 */
    TclWinFlushDirtyChannels, /* 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 */
    Tcl_MacOSXNotifierAddRunLoopMode, /* 2 */
#endif /* MACOSX */
    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

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 */
    0, /* 71 */
    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

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




︙


787
788
789
790
791
792
793
794

795
796
797
798
799
800
801
802

803
804
805
806
807
808
809

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 */
    Tcl_GetByteArrayFromObj, /* 33 */
    TclGetByteArrayFromObj, /* 33 */
    Tcl_GetDouble, /* 34 */
    Tcl_GetDoubleFromObj, /* 35 */
    0, /* 36 */
    Tcl_GetInt, /* 37 */
    Tcl_GetIntFromObj, /* 38 */
    Tcl_GetLongFromObj, /* 39 */
    Tcl_GetObjType, /* 40 */
    Tcl_GetStringFromObj, /* 41 */
    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

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




︙


1088
1089
1090
1091
1092
1093
1094
1095

1096
1097
1098
1099
1100


1101
1102
1103
1104
1105
1106
1107

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 */
    Tcl_UtfCharComplete, /* 326 */
    TclUtfCharComplete, /* 326 */
    Tcl_UtfBackslash, /* 327 */
    Tcl_UtfFindFirst, /* 328 */
    Tcl_UtfFindLast, /* 329 */
    Tcl_UtfNext, /* 330 */
    Tcl_UtfPrev, /* 331 */
    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

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 */
    Tcl_GetUnicodeFromObj, /* 434 */
    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

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

1
2
3
4
5
6


7
8
9
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 (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 1998 Paul Duffin.
 * 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

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;
    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, "Tcl", version, 0, &pkgData);
    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, "Tcl", version, 1, NULL);
		stubsPtr->tcl_PkgRequireEx(interp, tclName, version, 1, NULL);
		return NULL;
	    }
	} else {
	    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
	    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

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

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

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

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, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
    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

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

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

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, "teststaticpkg", TeststaticpkgCmd,
    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

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

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

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;
}

/*
 *----------------------------------------------------------------------
 *
 * TeststaticpkgCmd --
 * TeststaticlibraryCmd --
 *
 *	This procedure implements the "teststaticpkg" command.
 *	It is used to test the procedure Tcl_StaticPackage.
 *	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
TeststaticpkgCmd(
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], " pkgName safe loaded\"", NULL);
		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_StaticPackage((loaded) ? interp : NULL, argv[1],
    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

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, "TclGetStringFromObj of \"12345\" 100000 times\n");
    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 TclGetStringFromObj of \"12345\"\n",
    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

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"
	    first = buffer;
	    break;
		    "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

7033
7034
7035
7036
7037
7038
7039

7040
7041
7042
7043
7044
7045
7046
7047








-
+








	}
	if (offset > numBytes) {
	    offset = numBytes;
	}
    } else {
	offset = numBytes;
    }
    result = TclUtfPrev(bytes + offset, bytes);
    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

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

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

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], &length);
	    string = Tcl_GetStringFromObj(objv[3], &size);
	    if ((varPtr[varIndex] != NULL)
		    && !Tcl_IsShared(varPtr[varIndex])) {
		Tcl_SetStringObj(varPtr[varIndex], string, length);
		Tcl_SetStringObj(varPtr[varIndex], string, size);
	    } else {
		SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length));
		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

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], &length);
	    string = Tcl_GetStringFromObj(varPtr[varIndex], &size);

	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((i < 0) || (i > length)) {
	    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, length - i);
	    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], &length);
	    unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size);

	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((i < 0) || (i > length)) {
	    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, length - i);
	    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

1
2
3
4
5
6
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.
 * 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[] = "procbodytest";
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

71
72
73
74
75
76
77

78
79
80
81
82
83
84
85








-
+








};

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_Init --
 *
 *	This function initializes the "procbodytest" package.
 *	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

95
96
97
98
99
100
101

102
103
104
105
106
107
108
109








-
+








}

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_SafeInit --
 *
 *	This function initializes the "procbodytest" package.
 *	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

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

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

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

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 numWaits;		/* Number of waits to acquire a lock */
    size_t numLocks;		/* Number of locks acquired */
    size_t totalAssigned;	/* Total space assigned to bucket */
    size_t totalAssigned;		/* Total space assigned to bucket */
} Bucket;

/*
 * The following structure defines a cache of buckets and objs, of which there
 * will be (at most) one per thread. Any changes need to be reflected in the
 * struct AllocCache defined in tclInt.h, possibly also in the initialisation
 * code in Tcl_CreateInterp().
 */

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 */
    size_t numObjects;		/* Number of objects for thread */
    Tcl_Obj *lastPtr;		/* Last object in this cache */
    int totalAssigned;		/* Total space assigned to thread */
    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

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, int numMove);
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, unsigned int reqSize);
static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
static void	PutObjs(Cache *fromPtr, int numMove);
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

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) {
	int numMove;
	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 %d new objects", numMove);
		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) {
	    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

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 %" TCL_Z_MODIFIER "u",
	    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,
		    cachePtr->buckets[n].numLocks);
		    cachePtr->buckets[n].numWaits);
	    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

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,
    int numMove)
    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) {
    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

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,
    int numMove)
    size_t numMove)
{
    int keep = fromPtr->numObjects - 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 > 0);
	} 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

777
778
779
780
781
782
783

784
785
786
787
788
789
790
791








-
+








 *----------------------------------------------------------------------
 */

static void *
Block2Ptr(
    Block *blockPtr,
    int bucket,
    unsigned int reqSize)
    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

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,
    int numMove)
    size_t numMove)
{
    /*
     * We have numFree.  Want to shed numMove. So compute how many
     * Blocks to keep.
     */

    int keep = cachePtr->buckets[bucket].numFree - numMove;
    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 > 0);
	} 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

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

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

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

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 ?
		1 << (NBUCKETS - 2 - i) : 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

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

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

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

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

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];
	    char buf[TCL_INTEGER_SPACE];

	    sprintf(buf, "%" TCL_LL_MODIFIER "d", id);
	    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

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

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);
	command = Tcl_GetStringFromObj(commandPtr, &length);
	for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
		afterPtr = afterPtr->nextPtr) {
	    tempCommand = TclGetStringFromObj(afterPtr->commandPtr,
	    tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
		    &tempLength);
	    if ((length == tempLength)
		    && !memcmp(command, tempCommand, length)) {
		break;
	    }
	}
	if (afterPtr == NULL) {




︙







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

1
2
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 (c) 2005 by Kevin B. Kenny.  All rights reserved.
# 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
# hooks {tclTomMathInt}
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

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

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

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

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);
/* Slot 71 is reserved */
/* 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

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 */
    void (*reserved71)(void);
    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

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 */
/* Slot 71 is reserved */
#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

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

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

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

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

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

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

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

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

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

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,
/* 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,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    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,
    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
#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,
    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
#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);

/*




︙


691
692
693
694
695
696
697
698

699
700
701
702
703
704
705

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) && TclUCS4Complete(p, endPtr-p)) {
    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

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 (TclChar16Complete(p, endPtr-p)) {
	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

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

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

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 >= complete[byte])) {
		    || (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

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 < TCL_UTF_MAX);
    } while (trailBytesSeen < 4);

    /*
     * We've seen TCL_UTF_MAX trail bytes, so we know there will not be a
     * 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 (for TCL_UTF_MAX > 3) or just go back as
     * accepting the fallback.
     * far as we can.
     */
#if TCL_UTF_MAX > 3
    return fallback;
#else
    return src - TCL_UTF_MAX;
#endif
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharAtIndex --
 *




︙


1747
1748
1749
1750
1751
1752
1753
1754

1755
1756
1757
1758
1759
1760
1761

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

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. */
{
#ifdef WORDS_BIGENDIAN
#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

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

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[01] & 0x3FF)) + 0x10000;
	*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

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

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;
	size_t pInc = 0, bytesLeft = numTrim;

	pp = TclUtfPrev(p, bytes);
	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 {
	    size_t qInc = TclUtfToUCS4(q, &ch2);
	    pInc = TclUtfToUCS4(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;
	    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

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

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)TclGetStringFromObj(objPtr, &length);
	(void)Tcl_GetStringFromObj(objPtr, &length);
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
	    objPtr = objv[i];
	    if (!TclListObjIsCanonical(objPtr)) {
		continue;
	    }
	    if (resPtr) {
		Tcl_Obj *elemPtr = NULL;

		Tcl_ListObjIndex(NULL, objPtr, 0, &elemPtr);
		if (elemPtr == NULL) {
		    continue;
		}
		if (Tcl_GetString(elemPtr)[0] == '#' || TCL_OK
		if (TCL_OK != Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
			!= 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

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 = TclGetStringFromObj(objv[i], &elemLength);
	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 = TclGetStringFromObj(objv[i], &elemLength);
	element = Tcl_GetStringFromObj(objv[i], &elemLength);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;





︙


2489
2490
2491
2492
2493
2494
2495
2496
2497


2498
2499
2500
2501
2502
2503
2504


2505
2506
2507
2508
2509
2510
2511

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 = TclGetUnicodeFromObj(strObj, &length);
	uptn  = TclGetUnicodeFromObj(ptnObj, &plen);
	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 = TclGetByteArrayFromObj(strObj, &length);
	ptn  = TclGetByteArrayFromObj(ptnObj, &plen);
	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

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 = TclGetStringFromObj(objPtr, &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

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 = TclGetStringFromObj(objPtr, &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

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

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

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

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

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.
 *	Adapted from the implementation for AndroWish.
 *
 * Copyright (c) 2016-2017 Sean Woods <[email protected]>
 * Copyright (c) 2013-2015 Christian Werner <[email protected]>
 * 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

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"

#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_FALLBACK_ENCODING "cp437"
#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





︙


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

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) \
/*
 * 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 {			     \
    do {								\
	(p)[0] = (v) & 0xff;	     \
	(p)[1] = ((v) >> 8) & 0xff;  \
	(p)[2] = ((v) >> 16) & 0xff; \
	(p)[3] = ((v) >> 24) & 0xff; \
    } while (0)
	if (interp) {							\
#define ZipWriteShort(p, v) \
    do {			    \
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode, NULL);	\
	}								\
	(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 */

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

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 */
    Tcl_WideInt offset;		/* Data offset into memory mapped ZIP 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

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 */
    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, 0,
    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 Tcl_WideInt ZipChannelWideSeek(void *instanceData, Tcl_WideInt offset,
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

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

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

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

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 ZipEntry *
static inline ZipEntry *
ZipFSLookup(
    char *filename)
    const char *filename)
{
    Tcl_HashEntry *hPtr;
    ZipEntry *z = NULL;

    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename);
    if (hPtr) {
	z = (ZipEntry *)Tcl_GetHashValue(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;
}


/*
 *-------------------------------------------------------------------------
 *
 * 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)
static inline ZipChannel *
AllocateZipChannel(
    Tcl_Interp *interp)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    ZipChannel *zc = (ZipChannel *) Tcl_AttemptAlloc(sizeof(ZipChannel));
    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	   hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = Tcl_GetHashValue(hPtr);

	if (strcmp(zf->mountPoint, filename) == 0) {
    if (!zc) {
	    return 1;
	}
	ZIPFS_MEM_ERROR(interp);
    } else {
	memset(zc, 0, sizeof(ZipChannel));
    }
    return 0;
    return zc;
}
#endif /* NEVER_USED */

/*
 *-------------------------------------------------------------------------
 *
 * 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

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;
	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);
	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.
 *	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;
    unsigned char *p, *q;
    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 >= zf->data) {
    while (p >= start) {
	if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) {
	    if (ZipReadInt(p) == ZIP_CENTRAL_END_SIG) {
	    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");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "END_SIG", NULL);
	}
	goto error;
    }
    zf->numFiles = ZipReadShort(p + ZIP_CENTRAL_ENTS_OFFS);
	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");
	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)
	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");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_DIR", NULL);
	}
	goto error;
    }
	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 > zf->data + zf->length) {
	if (q + ZIP_CENTRAL_HEADER_LEN > end) {
	    ZIPFS_ERROR(interp, "wrong header length");
	    if (interp) {
	    ZIPFS_ERROR_CODE(interp, "HDR_LEN");
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_LEN", NULL);
	    }
	    goto error;
	}
	if (ZipReadInt(q) != ZIP_CENTRAL_HEADER_SIG) {
	if (ZipReadInt(start, end, q) != ZIP_CENTRAL_HEADER_SIG) {
	    ZIPFS_ERROR(interp, "wrong header signature");
	    if (interp) {
	    ZIPFS_ERROR_CODE(interp, "HDR_SIG");
		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);
	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(q - 4) == ZIP_PASSWORD_END_SIG)) {
    if ((zf->baseOffset >= 6) &&
	    (ZipReadInt(start, end, q - 4) == ZIP_PASSWORD_END_SIG)) {
	const unsigned char *passPtr;

	i = q[-5];
	if (q - 5 - i > zf->data) {
	passPtr = q - 5 - i;
	if (passPtr >= start && passPtr + i < end) {
	    zf->passBuf[0] = i;
	    memcpy(zf->passBuf + 1, q - 5 - i, 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

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;
    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 (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 == TCL_IO_FAILURE) {
	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");
	    if (interp) {
	    ZIPFS_ERROR_CODE(interp, "FILE_SIZE");
		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);
	zf->ptrToFree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length);
	if (!zf->ptrToFree) {
	    ZIPFS_ERROR(interp, "out of memory");
	    if (interp) {
	    ZIPFS_MEM_ERROR(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);
	Tcl_Close(interp, zf->chan);
	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");
    return ZipFSFindTOC(interp, needZip, zf);
	    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;
     * Handle errors by closing the archive. This includes closing the channel
	}
	lseek(PTR2INT(handle), 0, SEEK_SET);
     * handle for the archive file.
	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;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipMapArchive --
 *
 *	Wrapper around the platform-specific parts of mmap() (and Windows's
 *	equivalent) because it's not part of the standard channel API.
 *
 *-------------------------------------------------------------------------
 */
 * ZipFSRootNode --
 *
 *	This function generates the root node for a ZIPFS filesystem.

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 *zf0,
    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 *zf;
    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 ((pwlen > 255) || strchr(passwd, 0xff)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
	if (IsPasswordValid(interp, passwd, pwlen) != TCL_OK) {
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    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) {
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    zf0 = (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);
		    "%s is already mounted on %s", zf0->name, mountPoint));
	    ZIPFS_ERROR_CODE(interp, "MOUNTED");
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	ZipFSCloseArchive(interp, zf);
	return TCL_ERROR;
    }
    zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	Tcl_Free(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();

    /*
     * Convert to a real archive descriptor.
     */
    *zf = *zf0;
    zf->mountPoint = (char *)Tcl_GetHashKey(&ZipFS.zipHash, hPtr);

    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);
    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));
	    z = AllocateZipEntry();
	    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->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(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	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);
	Tcl_DStringSetLength(&ds, 0);
	Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
	path = DecodeZipEntryText(q + ZIP_CENTRAL_HEADER_LEN, pathlen, &ds);
	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)) {
		+ ZipReadInt(start, end, q + ZIP_CENTRAL_LOCALHDR_OFFS);
	if ((lq < start) || (lq + ZIP_LOCAL_HEADER_LEN > end)) {
	    goto nextent;
	}
	nbcompr = ZipReadInt(lq + ZIP_LOCAL_COMPLEN_OFFS);
	nbcompr = ZipReadInt(start, end, lq + ZIP_LOCAL_COMPLEN_OFFS);
	if (!isdir && (nbcompr == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
		&& (ZipReadInt(start, end, lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0)
		&& (ZipReadInt(start, end, lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
	    gq = q;
	    nbcompr = ZipReadInt(gq + ZIP_CENTRAL_COMPLEN_OFFS);
	    nbcompr = ZipReadInt(start, end, 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);
		+ 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);
	    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2));
	    if (ZipFSLookup(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 = AllocateZipEntry();
	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)
	z->isEncrypted =
		(ZipReadShort(start, end, 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->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(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(gq + ZIP_CENTRAL_COMPMETH_OFFS);
	    z->numBytes = ZipReadInt(start, end,
		    gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(start, end,
		    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->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(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(lq + ZIP_LOCAL_COMPMETH_OFFS);
	    z->numBytes = ZipReadInt(start, end,
		    lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(start, end,
		    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);
	    goto nextent;
	}
	} 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_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 (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;
	    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->tnext = NULL;
		    zd->depth = CountSlashes(dir);
		    zd->zipFilePtr = zf;
		    zd->isDirectory = 1;
		zd->depth = CountSlashes(dir);
		zd->zipFilePtr = zf;
		zd->isDirectory = 1;
		    zd->isEncrypted = 0;
		    zd->offset = z->offset;
		zd->offset = z->offset;
		    zd->crc32 = 0;
		    zd->timestamp = z->timestamp;
		zd->timestamp = z->timestamp;
		    zd->numBytes = zd->numCompressedBytes = 0;
		    zd->compressMethod = ZIP_COMPMETH_STORED;
		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;
		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

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

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;

    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);
    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 (interp ? TCL_OK : TCL_BREAK);
    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

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)
{
    Tcl_HashEntry *hPtr;
    ZipFile *zf;
    if (interp) {
	ZipFile *zf = ZipFSLookupZip(mountPoint);

    if (interp) {
	hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
	if (hPtr) {
	if (zf) {
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    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

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

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) {
    if (passwd && IsPasswordValid(interp, passwd, strlen(passwd)) != TCL_OK) {
	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;
	}
	return TCL_ERROR;
    }
    }
    zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    zf = AllocateZipFile(interp, strlen(mountPoint));
    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 --




︙


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

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 = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    zf = AllocateZipFile(interp, strlen(mountPoint));
    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);
	zf->data = (unsigned char *) Tcl_AttemptAlloc(datalen);
	if (!zf->data) {
	    if (interp) {
	    ZIPFS_MEM_ERROR(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 --




︙


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

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

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

    return TclZipfs_Mount(interp, (objc > 1) ? TclGetString(objv[1]) : NULL,
	    (objc > 2) ? TclGetString(objv[2]) : NULL,
	    (objc > 3) ? TclGetString(objv[3]) : NULL);
    }
    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

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 = 0;
    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

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

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;
    char *pw, passBuf[264];
    const char *pw;
    Tcl_Obj *passObj;
    unsigned char *passBuf;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = TclGetString(objv[1]);
    pw = TclGetStringFromObj(objv[1], &len);
    len = strlen(pw);
    if (len == 0) {
	return TCL_OK;
    }
    if ((len > 255) || strchr(pw, 0xff)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1));
    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];
	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);
    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 ZipFSMkZipOrImgCmd() to add a single file to
 *	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. */
    const char *path,
    const char *name,
    Tcl_Channel out,
    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,
    int bufsize,
    Tcl_HashTable *fileHash)
    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 *zpath;
    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;
    Tcl_WideInt pos[3];
    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.
     */

    zpath = name;
    while (zpath && zpath[0] == '/') {
	zpath++;
    zpathTcl = name;
    while (zpathTcl && zpathTcl[0] == '/') {
	zpathTcl++;
    }
    if (!zpath || (zpath[0] == '\0')) {
    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(zpath);
    zpathlen = strlen(zpathExt);
    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);
		"path too long for \"%s\"", TclGetString(pathObj)));
	ZIPFS_ERROR_CODE(interp, "PATH_LEN");
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;
    }
    in = Tcl_OpenFileChannel(interp, path, "rb", 0);
    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_CloseEx(interp, in, 0);
	    Tcl_Close(interp, in);
	    return TCL_OK;
	}
#endif /* _WIN32 */
	Tcl_CloseEx(interp, in, 0);
	Tcl_Close(interp, in);
	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);

    /*
     * Compute the CRC.
     */

    crc = 0;
    nbyte = nbytecompr = 0;
    while (1) {
	len = Tcl_Read(in, buf, bufsize);
	if (len == TCL_IO_FAILURE) {
	if (len == ERROR_LENGTH) {
	    Tcl_DStringFree(&zpathDs);
	    if (nbyte == 0 && errno == EISDIR) {
		Tcl_CloseEx(interp, in, 0);
		Tcl_Close(interp, in);
		return TCL_OK;
	    }
	readErrorWithChannelOpen:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
		    path, Tcl_PosixError(interp)));
	    Tcl_CloseEx(interp, in, 0);
		    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",
		path, Tcl_PosixError(interp)));
	Tcl_CloseEx(interp, in, 0);
		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).
     */

    pos[0] = Tcl_Tell(out);
    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, zpath, zpathlen);
    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen);
    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
    if (Tcl_Write(out, buf, len) != len) {
    wrerr:
    if ((size_t) Tcl_Write(out, buf, len) != len) {
    writeErrorWithChannelOpen:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error on %s: %s", path, Tcl_PosixError(interp)));
	Tcl_CloseEx(interp, in, 0);
		"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 + pos[0]) & 3) {
    if ((len + headerStartOffset) & 3) {
	unsigned char abuf[8];

	/*
	const unsigned char *astart = abuf;
	const unsigned char *aend = 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;
	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];
	Tcl_Obj *ret;

	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    double r;

	    if (RandomChar(interp, i, &ch) != TCL_OK) {
	    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);
		Tcl_Close(interp, in);
		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)));
	    goto writeErrorWithChannelOpen;
	    Tcl_CloseEx(interp, in, 0);
	    return TCL_ERROR;
	}
	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);
    pos[2] = Tcl_Tell(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\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE_INIT", NULL);
	Tcl_CloseEx(interp, in, 0);
		"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 == TCL_IO_FAILURE) {
	if (len == ERROR_LENGTH) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "read error on %s: %s", path, Tcl_PosixError(interp)));
	    deflateEnd(&stream);
	    Tcl_CloseEx(interp, in, 0);
	    goto readErrorWithChannelOpen;
	    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);
			"deflate error on \"%s\"", TclGetString(pathObj)));
		ZIPFS_ERROR_CODE(interp, "DEFLATE");
		deflateEnd(&stream);
		Tcl_CloseEx(interp, in, 0);
		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 && (Tcl_Write(out, obuf, olen) != olen)) {
	    if (olen && ((size_t) 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;
		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);
    pos[1] = Tcl_Tell(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, pos[2], SEEK_SET) != pos[2]) {
	if (Tcl_Seek(out, dataStartOffset, SEEK_SET) != dataStartOffset) {
	seekErr:
	    Tcl_CloseEx(interp, in, 0);
	    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 == TCL_IO_FAILURE) {
	    if (len == ERROR_LENGTH) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"read error on \"%s\": %s",
			path, Tcl_PosixError(interp)));
		goto readErrorWithChannelOpen;
		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) {
	    if ((size_t) Tcl_Write(out, buf, len) != len) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		goto writeErrorWithChannelOpen;
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    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);
	pos[1] = Tcl_Tell(out);
	Tcl_TruncateChannel(out, pos[1]);
	dataEndOffset = Tcl_Tell(out);
	Tcl_TruncateChannel(out, dataEndOffset);
    }
    Tcl_CloseEx(interp, in, 0);
    Tcl_Close(interp, in);
    Tcl_DStringFree(&zpathDs);
    zpathExt = NULL;

    hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
    hPtr = Tcl_CreateHashEntry(fileHash, zpathTcl, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"non-unique path name \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DUPLICATE_PATH", NULL);
		"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 = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry));

    z = AllocateZipEntry();
    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->offset = headerStartOffset;
    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->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);

    SerializeLocalEntryHeader(start, end, (unsigned char *) buf, z,
    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]) {
	    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, pos[1], SEEK_SET) != pos[1]) {
    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;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipOrImgObjCmd --
 * 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.
 *	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
ZipFSMkZipOrImgObjCmd(
ZipFSMkZipOrImg(
    Tcl_Interp *interp,		/* Current interpreter. */
    int isImg,
    int isList,
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    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, count, ret = TCL_ERROR, lobjc;
    size_t len, slen = 0, i = 0;
    Tcl_WideInt pos[3];
    Tcl_Obj **lobjv, *list = NULL;
    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 (objc > (isList ? 3 : 4)) {
	pw = TclGetString(objv[isList ? 3 : 4]);
    if (passwordObj != NULL) {
	pw = TclGetStringFromObj(passwordObj, &pwlen);
	pwlen = strlen(pw);
	if ((pwlen > 255) || strchr(pw, 0xff)) {
	    Tcl_SetObjResult(interp,
	if (IsPasswordValid(interp, pw, pwlen) != TCL_OK) {
		    Tcl_NewStringObj("illegal password", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    return TCL_ERROR;
	}
	if (pwlen <= 0) {
	    pw = NULL;
	    pwlen = 0;
    }
	}
    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];
    if (dirRoot != NULL) {
	cmd[0] = Tcl_NewListObj(2, cmd + 1);
	Tcl_IncrRefCount(cmd[0]);
	if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) {
	list = ZipFSFind(interp, dirRoot);
	    Tcl_DecrRefCount(cmd[0]);
	if (!list) {
	    return TCL_ERROR;
	}
	Tcl_DecrRefCount(cmd[0]);
	list = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(list);
    }
    Tcl_IncrRefCount(list);
    if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (isList && (lobjc % 2)) {
    if (mappingList && (lobjc % 2)) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("need even number of elements", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "LIST_LENGTH", NULL);
	ZIPFS_ERROR(interp, "need even number of elements");
	ZIPFS_ERROR_CODE(interp, "LIST_LENGTH");
	return TCL_ERROR;
    }
    if (lobjc == 0) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
	ZIPFS_ERROR(interp, "empty archive");
	ZIPFS_ERROR_CODE(interp, "EMPTY");
	return TCL_ERROR;
    }
    out = Tcl_OpenFileChannel(interp, TclGetString(objv[1]), "wb", 0755);
    out = Tcl_FSOpenFileChannel(interp, targetFile, "wb", 0755);
    if (out == NULL) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (pwlen <= 0) {

	pw = NULL;
	pwlen = 0;
    }
    /*
     * 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;

	if (isList) {
	    imgName = (objc > 4) ? TclGetString(objv[4]) :
		    Tcl_GetNameOfExecutable();
	// TODO: normalize the origin file name
	imgName = (originFile != NULL) ? TclGetString(originFile) :
		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++;




︙


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

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);
	    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 (Tcl_Write(out, (char *) zf->data,
	    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_CloseEx(interp, out, 0);
		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 {
	    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 (CopyImageFile(interp, imgName, out) != TCL_OK) {
	    if (!in) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_CloseEx(interp, out, 0);
		Tcl_Close(interp, out);
		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);
	}
	/*
	 * 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_CloseEx(interp, out, 0);
		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);
    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;

    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,
	path = TclGetString(lobjv[i]);
	if (isList) {
	    name = TclGetString(lobjv[i + 1]);
		(mappingList ? lobjv[i + 1] : NULL), strip, slen);
	} 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),
	if (ZipAddFile(interp, pathObj, name, out, pw, buf, sizeof(buf),
		&fileHash) != TCL_OK) {
	    goto done;
	}
    }

    /*
     * Construct the contents of the ZIP central directory.
     */

    pos[1] = Tcl_Tell(out);
    directoryStartOffset = Tcl_Tell(out);
    count = 0;
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = TclGetString(lobjv[i]);
    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;
	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);
	z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, -1, &ds);
	len = Tcl_DStringLength(&ds);
	SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
	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);
		z, len, dataStartOffset);
	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)) {
	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);
    pos[2] = Tcl_Tell(out);
    suffixStartOffset = 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);
    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_CloseEx(interp, out, 0);
	ret = Tcl_Close(interp, out);
    } else {
	Tcl_CloseEx(interp, out, 0);
	Tcl_Close(interp, out);
    }
    Tcl_DecrRefCount(list);
    for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
	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 ZipFSMkZipOrImgCmd().
 *	lmkzip] commands.  See description of ZipFSMkZipOrImg().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *	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)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	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 ZipFSMkZipOrImgObjCmd(interp, 0, 0, objc, objv);
    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)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	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 ZipFSMkZipOrImgObjCmd(interp, 0, 1, objc, objv);
    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 ZipFSMkZipOrImgCmd().
 *	lmkimg] commands.  See description of ZipFSMkZipOrImg().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *	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)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	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 ZipFSMkZipOrImgObjCmd(interp, 1, 0, objc, objv);
    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)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	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 ZipFSMkZipOrImgObjCmd(interp, 1, 1, objc, objv);
    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

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

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) {
	size_t n;
	char *what = TclGetStringFromObj(objv[1], &n);

	int idx;

	if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
		0, &idx) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) {
	switch (idx) {
	case OPT_GLOB:
	    pattern = TclGetString(objv[2]);
	} else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) {
	    break;
	case OPT_REGEXP:
	    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;
	    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);
	    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);
	    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);
	    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

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

#ifdef _WIN32
#define LIBRARY_SIZE	    64
#endif /* _WIN32 */

Tcl_Obj *
TclZipfs_TclLibrary(void)
{
    Tcl_Obj *vfsInitScript;
    int found;
#ifdef _WIN32
#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

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)
#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);
    }
#elif /* !_WIN32 && */ defined(CFG_RUNTIME_DLLFILE)
#else
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
    if (ZipfsAppHookFindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#endif /* _WIN32 || CFG_RUNTIME_DLLFILE */

#endif /* _WIN32 */
#endif /* !defined(STATIC_BUILD) */
    /*
     * 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) {




︙


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

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

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 Tcl_WideInt
static long long
ZipChannelWideSeek(
    void *instanceData,
    Tcl_WideInt offset,
    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

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

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.
 *	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,
    int mode,
    TCL_UNUSED(int) /*permissions*/)
    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 i, ch, trunc, wr, flags = 0;
    int flags = 0;
    char cname[128];

    if ((mode & O_APPEND)
	    || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) {
	if (interp) {
    /*
     * Is the file there?
	    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)

    /*
     * Do we support opening the file that way?
     */

    if (wr && z->isDirectory) {
	    && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) {
	ZIPFS_ERROR(interp, "unsupported compression method");
	Tcl_SetErrno(EISDIR);
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "COMP_METHOD", NULL);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unsupported file type: %s",
		    Tcl_PosixError(interp)));
	}
	goto error;
    }
    if (wr && z->isDirectory) {
	ZIPFS_ERROR(interp, "unsupported file type");
	if (interp) {
    if ((z->compressMethod != ZIP_COMPMETH_STORED)
	    && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) {
	ZIPFS_ERROR(interp, "unsupported compression method");
	ZIPFS_ERROR_CODE(interp, "COMP_METHOD");
	    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) {
	    ZIPFS_ERROR_CODE(interp, "DECRYPT");
		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) {
	    ZIPFS_ERROR_CODE(interp, "FILE_SIZE");
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
    } else {
	flags = TCL_WRITABLE;
    }
    info = (ZipChannel *)Tcl_AttemptAlloc(sizeof(ZipChannel));

    info = AllocateZipChannel(interp);
    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) {
	/*
	 * 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.
	 */
	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;

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

	 * Need to uncompress the existing data.
		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;
	unsigned char *zbuf = z->zipFilePtr->data + z->offset;

		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) {
	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;
	    zbuf += i;
	}
	if (info->iscompr) {

	if (z->compressMethod == ZIP_COMPMETH_DEFLATED) {
	    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) {
	    if (z->isEncrypted) {
		unsigned int j;

		stream.avail_in -= 12;
		ubuf = (unsigned char *)Tcl_AttemptAlloc(stream.avail_in);
		if (!ubuf) {
		cbuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in);
		if (!cbuf) {
		    info->ubuf = NULL;
		    goto merror;
		    goto memoryError;
		}
		for (j = 0; j < stream.avail_in; j++) {
		    ch = info->ubuf[j];
		    ubuf[j] = zdecode(info->keys, crc32tab, ch);
		    cbuf[j] = zdecode(info->keys, crc32tab, ch);
		}
		stream.next_in = ubuf;
		stream.next_in = cbuf;
	    } else {
		stream.next_in = info->ubuf;
		stream.next_in = zbuf;
	    }
	    stream.next_out = info->ubuf = (unsigned char *)Tcl_AttemptAlloc(info->numBytes);
	    stream.next_out = info->ubuf;
	    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;
	    stream.avail_out = info->maxWrite;
	    if (inflateInit2(&stream, -15) != Z_OK) {
		goto cerror;
		goto corruptionError;
	    }
	    err = inflate(&stream, Z_SYNC_FLUSH);
	    inflateEnd(&stream);
	    if ((err == Z_STREAM_END)
		    || ((err == Z_OK) && (stream.avail_in == 0))) {
		if (ubuf) {
		if (cbuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    Tcl_Free(ubuf);
		    Tcl_Free(cbuf);
		}
		goto wrapchan;
		return TCL_OK;
	    }
	cerror:
	    goto corruptionError;
	    if (ubuf) {
		info->isEncrypted = 0;
	} else if (z->isEncrypted) {
		memset(info->keys, 0, sizeof(info->keys));
		Tcl_Free(ubuf);
	    }
	    if (info->ubuf) {
		Tcl_Free(info->ubuf);
	    /*
	     * 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);
	    }
	    Tcl_Free(info);
	    ZIPFS_ERROR(interp, "decompression error");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
	    }
	    goto error;
	} else if (info->isEncrypted) {
	} else {
	    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.
	     * Simple stored data. Copy into our working buffer.
	     */

	    memcpy(info->ubuf, zbuf, z->numBytes);
	}
	memset(info->keys, 0, sizeof(info->keys));
    }
    return TCL_OK;
	    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++) {

  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);
	    }
	    info->ubuf = ubuf;
	    info->isEncrypted = 0;
	    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;
    }

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

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,
    int permissions)
    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), mode,
    return ZipChannelOpen(interp, TclGetString(pathPtr), wr, trunc);
	    permissions);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSStatProc --
 *




︙


4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031

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

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,
    Tcl_Obj *pathPtr,
    const char *pattern,
    Tcl_GlobTypeData *types)
    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, strip = 0;
    size_t len, prefixLen;
    int scnt, l, dirOnly = -1, prefixLen, strip = 0, mounts = 0;
    int len;
    char *pat, *prefix, *path;
    Tcl_DString dsPref;
    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);
    Tcl_DStringAppend(&dsPref, prefix, prefixLen);

    if (strcmp(prefix, path) == 0) {
	prefix = NULL;
	prefixBuf = NULL;
    } else {
	/*
	strip = len + 1;
    }
    if (prefix) {
	 * 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);
	prefixLen++;
	prefix = Tcl_DStringValue(&dsPref);
	prefixBuf = &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) {
    /*
     * Are we globbing the mount points?
		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) {
    if (mounts) {
	ZipFSMatchMountPoints(result, normPathPtr, pattern, prefixBuf);
			    Tcl_DStringAppend(&dsPref, z->name, lenz);
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
					    Tcl_DStringLength(&dsPref)));
			    Tcl_DStringSetLength(&dsPref, prefixLen);
			} else {
	goto end;
			    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)) {
    /*
     * Can we skip the complexity of actual globbing? Without a pattern, yes;
		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 {
     * it's a directory existence test.
		    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);
	ZipEntry *z = ZipFSLookup(path);

	    if ((dirOnly < 0) || (!dirOnly && !z->isDirectory)
		    || (dirOnly && z->isDirectory)) {
	if (z && ((dirOnly < 0) || (!dirOnly && !z->isDirectory)
		|| (dirOnly && z->isDirectory))) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, z->name, -1);
	    AppendWithPrefix(result, prefixBuf, 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;
    }
	}
	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);
    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);
	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));
	    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

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;
    int ret = -1, len;
    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);
	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) &&
		if ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) {
			(strncmp(path, z->name, lenz) == 0)) {
		    ret = TCL_OK;
		    goto endloop;
		}
	    }
	} else if ((len >= zf->mountPointLen) &&
	} 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

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

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 ret = TCL_OK;
    int len, ret = TCL_OK;
    char *path;
    ZipEntry *z;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = TclGetString(pathPtr);
    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 0:
    case ZIP_ATTR_UNCOMPSIZE:
	TclNewIntObj(*objPtrRef, z->numBytes);
	break;
    case 1:
    case ZIP_ATTR_COMPSIZE:
	TclNewIntObj(*objPtrRef, z->numCompressedBytes);
	break;
    case 2:
    case ZIP_ATTR_OFFSET:
	TclNewIntObj(*objPtrRef, z->offset);
	break;
    case 3:
    case ZIP_ATTR_MOUNT:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint,
		z->zipFilePtr->mountPointLen);
	break;
    case 4:
    case ZIP_ATTR_ARCHIVE:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, -1);
	break;
    case 5:
    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

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*/)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "UNSUPPORTED_OP", NULL);
    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

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 > execName + 1) {
	    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

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

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::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_PkgProvideEx(interp, "zipfs", "2.0", NULL);
	Tcl_PkgProvide(interp, "tcl::zipfs", "2.0");
    }
    return TCL_OK;
#else /* !HAVE_ZLIB */
    ZIPFS_ERROR(interp, "no zlib available");
    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    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

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;
    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
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 */
{
    char *archive;
    const char *archive;
    const char *result;

#ifdef _WIN32
    Tcl_FindExecutable(NULL);
    result = Tcl_FindExecutable(NULL);
#else
    Tcl_FindExecutable((*argvPtr)[0]);
    result = Tcl_FindExecutable((*argvPtr)[0]);
#endif
    archive = (char *) Tcl_GetNameOfExecutable();
    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

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

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

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 TCL_OK;
		return result;
	    }
	}
#ifdef _WIN32
	Tcl_DStringFree(&ds);
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
    }
    return TCL_OK;
    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

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");
    if (interp) {
    ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
	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) {
    ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
	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) {
    ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
	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:
 */








Changes to generic/tclZlib.c.



1
2
3
4
5
6
7
8



9
10
11
12
13
14
15

1
2
3
4
5



6
7
8
9
10
11
12
13
14
15






-
-
-
+
+
+








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

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

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);
	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 = TclGetByteArrayFromObj(compDictObj, &length);
	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

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

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

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

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

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

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

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)
    return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL);
    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

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

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)
        }
	if {[info exists env($enVarName)]} {
	    lappend dirs $env($enVarName)
	}

	catch {
      set found 0
	    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]
	    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 {[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]} {
		    && ![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 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}
            }
          }
        }
      }
   }
			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

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

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

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

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

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

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
	set fakeName [namespace current]::_%@fake_$tail
    } else {
        set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
	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]
	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
	set alias [namespace tail $fakeName]
	$parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
	$parser alias $alias $fakeName
    } else {
        $parser alias $name $fakeName
	$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

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
            }
        }
	foreach ns $contextStack {
	    set name "${ns}::$name"
	    if {[string match ::* $name]} {
		break
	    }
	}
    }

    if {[namespace qualifiers $name] eq ""} {
        set name [namespace tail $name]
	set name [namespace tail $name]
    } elseif {![string match ::* $name]} {
        set name "::$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

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
	eval {
	    variable parser
	    variable contextStack

            set name [lindex $args 0]
            set args [lrange $args 1 end]
	    set name [lindex $args 0]
	    set args [lrange $args 1 end]

            set contextStack [linsert $contextStack 0 $name]
	    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"}
        }
	    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

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

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




︙







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

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"}} {
	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 "\u0000\u0000"} {
	    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 "\u0000\u0000"} {
	    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

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
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
# 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 "\u002E\u3002\uFF0E\uFF61"] {
	foreach part [split $hostname "\x2E\u3002\uFF0E\uFF61"] {
	    if {[regexp {[^-A-Za-z0-9]} $part]} {
		if {[regexp {[^-A-Za-z0-9\u00a1-\uffff]} $part ch]} {
		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

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"] {
	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

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












1
2

3
4
5
6
7
8
9
10
11
12

-

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

if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
if {[package vsatisfies [package provide Tcl] 9.0-]} {
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde]
    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

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

1
2
3
4
5





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

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

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

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

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

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        1.0.17 {platform platform.tcl}
    0 platform::shell 1.1.4  {platform shell.tcl}
    1 tcltest         2.5.3  {tcltest tcltest.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

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

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

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

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


1
2
3

-
+



package ifneeded platform        1.0.14 [list source [file join $dir platform.tcl]]
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

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

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 {
	cygwin* {
	    set plat cygwin
	}
	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

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

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 > 8} {
	    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

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+
	    # 10.5+,11.0+
	    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 }
		    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

		    # Add 10.5 to 10.minor to patterns.
		    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}
			    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

405
406
407
408
409
410
411

412
413
414
415
416
417
418
419








-
+








    return $res
}


# ### ### ### ######### ######### #########
## Ready

package provide platform 1.0.14
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

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

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

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]
    # 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 $package to $target)"
			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 package loading
	if {$package eq ""} {
	    set msg "load error: empty filename and no package name"
	# 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 packages loading disabled\
			(trying to load $package to $target)"
	    return -code error "permission denied (static package)"
	    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

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]
	return [::interp invokehidden $child load $file $prefix $target]
    } on error msg {
	# Some packages return no error message.
	set msg0 "load of binary library for package $package failed"
	# 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


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

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24

25
26
27
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 by Scriptics Corporation.
# Copyright (c) 2000 by Ajuba Solutions
# 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.3
    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 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

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

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

644
645
646
647
648
649
650

651
652
653
654
655
656
657
658








-
+








	    }
	}
	return $valid
    }

    proc IsVerbose {level} {
	variable Option
	return [expr {[lsearch -exact $Option(-verbose) $level] >= 0}]
	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

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

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 {chan configure $f -blocking off}]}]
		    || [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

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

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

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

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]
    chan configure $fd -translation lf
    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

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

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

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

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

1
2
3
4















































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

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

1
2
3


4
5
6
7
8
9




-
-
+
+
+
+
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Lagos) {
    {-9223372036854775808 816 0 LMT}
    {-1588464816 3600 0 WAT}
    {-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

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}
    {-1309746436 10800 0 EAT}
    {-1262314800 9000 0 +0230}
    {-946780200 9900 0 +0245}
    {-315629100 10800 0 EAT}
    {-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

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}
    {-859744800 -19800 1 -0530}
    {-848255400 -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

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 1 EDT}
    {1425798000 -14400 0 AST}
    {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}




︙







Changes to library/tzdata/America/Nassau.



1
2
3
4
5





6
7
8
9
10
11
12

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






+
+
+
+
+








# 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

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

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}
    {-933645600 10800 1 EEST}
    {-857358000 7200 0 EEST}
    {-933638400 10800 1 EEST}
    {-923097600 7200 0 EEST}
    {-919036800 10800 1 EEST}
    {-857347200 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}
    {-825811200 7200 0 EEST}
    {-812678400 10800 1 EEST}
    {-794188800 7200 0 EEST}
    {-779846400 10800 1 EEST}
    {-762652800 7200 0 EEST}
    {-748310400 10800 1 EEST}
    {-731127600 7200 0 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

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}
    {334015200 10800 1 IDT}
    {337644000 7200 0 IST}
    {452556000 10800 1 IDT}
    {462232800 7200 0 IST}
    {334101600 10800 1 IDT}
    {337730400 7200 0 IST}
    {452642400 10800 1 IDT}
    {462319200 7200 0 IST}
    {482277600 10800 1 IDT}
    {495579600 7200 0 IST}
    {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

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}
    {-933645600 10800 1 EEST}
    {-857358000 7200 0 EEST}
    {-933638400 10800 1 EEST}
    {-923097600 7200 0 EEST}
    {-919036800 10800 1 EEST}
    {-857347200 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}
    {-825811200 7200 0 EEST}
    {-812678400 10800 1 EEST}
    {-794188800 7200 0 EEST}
    {-779846400 10800 1 EEST}
    {-762652800 7200 0 EEST}
    {-748310400 10800 1 EEST}
    {-731127600 7200 0 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

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}
    {334015200 10800 1 IDT}
    {337644000 7200 0 IST}
    {452556000 10800 1 IDT}
    {462232800 7200 0 IST}
    {334101600 10800 1 IDT}
    {337730400 7200 0 IST}
    {452642400 10800 1 IDT}
    {462319200 7200 0 IST}
    {482277600 10800 1 IDT}
    {495579600 7200 0 IST}
    {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

1
2
3
4
5
6


7
8
9
10
11





12
13
14
15
16
17







18
19
20
21
22
23
24
25

26
27
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}
    {-933645600 10800 1 IDT}
    {-857358000 7200 0 IST}
    {-933638400 10800 1 IDT}
    {-923097600 7200 0 IST}
    {-919036800 10800 1 IDT}
    {-857347200 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}
    {-825811200 7200 0 IST}
    {-812678400 10800 1 IDT}
    {-794188800 7200 0 IST}
    {-779846400 10800 1 IDT}
    {-762652800 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}
    {-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}
    {-591847200 10800 1 IDT}
    {-591840000 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}
    {-490838400 10800 1 IDT}
    {-482976000 7200 0 IST}
    {-459388800 10800 1 IDT}
    {-451526400 7200 0 IST}
    {-428544000 10800 1 IDT}
    {-418262400 7200 0 IST}
    {-400032000 10800 1 IDT}
    {-387428400 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}
    {334015200 10800 1 IDT}
    {337644000 7200 0 IST}
    {452556000 10800 1 IDT}
    {462232800 7200 0 IST}
    {334101600 10800 1 IDT}
    {337730400 7200 0 IST}
    {452642400 10800 1 IDT}
    {462319200 7200 0 IST}
    {482277600 10800 1 IDT}
    {495579600 7200 0 IST}
    {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

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
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 AST}
    {-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

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}
    {-1672558200 37800 1 ACDT}
    {-1665387000 34200 0 ACST}
    {-883639800 37800 1 ACDT}
    {-876126600 34200 0 ACST}
    {-876123000 34200 0 ACST}
    {-860398200 37800 1 ACDT}
    {-844677000 34200 0 ACST}
    {-844673400 34200 0 ACST}
    {-828343800 37800 1 ACDT}
    {-813227400 34200 0 ACST}
    {-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

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}
    {-1672560000 39600 1 AEDT}
    {-1665388800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-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

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}
    {-1672558200 37800 1 ACDT}
    {-1665387000 34200 0 ACST}
    {-883639800 37800 1 ACDT}
    {-876126600 34200 0 ACST}
    {-876123000 34200 0 ACST}
    {-860398200 37800 1 ACDT}
    {-844677000 34200 0 ACST}
    {-844673400 34200 0 ACST}
    {-828343800 37800 1 ACDT}
    {-813227400 34200 0 ACST}
    {-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

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) {
}
set TZData(:Australia/Currie) $TZData(:Australia/Hobart)
    {-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}
}








Changes to library/tzdata/Australia/Darwin.



1
2
3
4
5
6
7
8


9
10

11
12

13
14

15

1
2
3
4
5
6


7
8
9

10
11

12
13

14
15







-
-
+
+

-
+

-
+

-
+


# 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}
    {-1672558200 37800 1 ACDT}
    {-1665387000 34200 0 ACST}
    {-883639800 37800 1 ACDT}
    {-876126600 34200 0 ACST}
    {-876123000 34200 0 ACST}
    {-860398200 37800 1 ACDT}
    {-844677000 34200 0 ACST}
    {-844673400 34200 0 ACST}
    {-828343800 37800 1 ACDT}
    {-813227400 34200 0 ACST}
    {-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

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}
    {-1672555500 35100 1 +0945}
    {-1665384300 31500 0 +0945}
    {-883637100 35100 1 +0945}
    {-876123900 31500 0 +0945}
    {-876120300 31500 0 +0945}
    {-860395500 35100 1 +0945}
    {-844674300 31500 0 +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

1
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}
    {-1669892400 39600 0 AEDT}
    {-1665392400 36000 0 AEST}
    {-1615190400 39600 1 AEDT}
    {-1604304000 36000 0 AEST}
    {-1583920800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-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

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}
    {-1672560000 39600 1 AEDT}
    {-1665388800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-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

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}
    {-1672560000 39600 1 AEDT}
    {-1665388800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-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

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}
    {-1672552800 32400 1 AWDT}
    {-1665381600 28800 0 AWST}
    {-883634400 32400 1 AWDT}
    {-876121200 28800 0 AWST}
    {-876117600 28800 0 AWST}
    {-860392800 32400 1 AWDT}
    {-844671600 28800 0 AWST}
    {-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

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}
    {-1672560000 39600 1 AEDT}
    {-1665388800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-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

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

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

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}
    {467298000 43200 1 +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

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

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)))
#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(x) __declspec(deprecated("replaced by " #x))
#  define MP_DEPRECATED_PRAGMA(s) __pragma(message(s))
#endif
#else
#endif

#ifndef MP_DEPRECATED_PRAGMA
#  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

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;
#ifdef _MSC_VER
#define mp_get_mag_ull(a) ((unsigned __int64)mp_get_mag_u64(a))
#define mp_get_mag_ull(a) ((unsigned long long)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_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 __int64)mp_get_i64(a))
#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)
#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;
MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) unsigned long long 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);
MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, unsigned long long 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;




︙







Changes to macosx/GNUmakefile.




︙


84
85
86
87
88
89
90
91

92
93
94
95
96
97
98

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

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

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

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

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




︙


834
835
836
837
838
839
840
841
842
843
844
845
846
847
848

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




︙


1145
1146
1147
1148
1149
1150
1151
1152

1153
1154
1155
1156
1157
1158
1159

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

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




︙


1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754

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




︙







Changes to macosx/Tcl.xcodeproj/project.pbxproj.




︙


389
390
391
392
393
394
395
396

397
398
399
400
401
402
403

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

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




︙


834
835
836
837
838
839
840
841
842
843
844
845
846
847
848

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




︙


1145
1146
1147
1148
1149
1150
1151
1152

1153
1154
1155
1156
1157
1158
1159

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

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




︙


1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754

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




︙







Changes to macosx/tclMacOSXBundle.c.



1
2
3
4
5
6
7
8


9
10
11
12
13
14
15

1
2
3
4
5
6


7
8
9
10
11
12
13
14
15







-
-
+
+








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

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

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

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

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

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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 * TclpInitNotifier --
 *
 *	Initializes the platform specific notifier state.
 *
 * Results:
 *	Returns a handle to the notifier state for this thread.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

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

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: could not create CFRunLoopSource");
	    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: could not create "
		    "CFRunLoopObserver");
	    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: could not create "
		    "CFRunLoopObserver");
	    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

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: pthread_atfork failed");
	    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: could not create trigger pipe");
	    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: could not make receive pipe non "
		    "blocking");
	    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: could not make trigger pipe non "
		    "blocking");
	    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

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;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMacOSXNotifierAddRunLoopMode --
 * Tcl_MacOSXNotifierAddRunLoopMode --
 *
 *	Add the tcl notifier RunLoop source, observer and timer (if any)
 *	to the given RunLoop mode.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclMacOSXNotifierAddRunLoopMode(
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

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);
		(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 --
 * 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
Tcl_FinalizeNotifier(
    ClientData clientData)
TclpFinalizeNotifier(
    TCL_UNUSED(ClientData))
{
    ThreadSpecificData *tsdPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    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




︙


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

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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 * 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
Tcl_AlertNotifier(
TclpAlertNotifier(
    ClientData clientData)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)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 --
 * TclpSetTimer --
 *
 *	This function sets the current notifier timer value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Replaces any previous timer.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimer(
TclpSetTimer(
    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);
	    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

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))
{
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
 * TclpServiceModeHook --
 *
 *	This function is invoked whenever the service mode changes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ServiceModeHook(
TclpServiceModeHook(
    int mode)			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    ThreadSpecificData *tsdPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    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 --
 * TclpCreateFileHandler --
 *
 *	This function registers a file handler with the select notifier.
 *	This function registers a file handler with the notifier.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateFileHandler(
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;
    FileHandler *filePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);

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

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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 * 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
Tcl_DeleteFileHandler(
TclpDeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    FileHandler *filePtr, *prevPtr;
    int i, numFdBits;
    ThreadSpecificData *tsdPtr;
    int i, numFdBits = -1;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    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;
    filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr);
    if (filePtr == NULL) {
	return;
	}
	if (filePtr->fd == fd) {
	    break;
	}
    }

    /*
     * Find current max fd.
     */

    if (fd+1 == tsdPtr->numFdBits) {
    if (fd + 1 == tsdPtr->numFdBits) {
	numFdBits = 0;
	for (i = fd-1; i >= 0; i--) {
	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;
		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

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);
    for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd != fileEvPtr->fd) {
    filePtr = LookUpFileHandler(tsdPtr, fileEvPtr->fd, NULL);
    if (filePtr != NULL) {
	    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




︙


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

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);
	}
	break;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 * 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
Tcl_WaitForEvent(
TclpWaitForEvent(
    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");




︙


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

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) {
	    tclScaleTimeProcPtr(&vTime, tclTimeClientData);
	    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.
	     * 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

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

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

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;
    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);

    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

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

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

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
TclMacOSXNotifierAddRunLoopMode(
Tcl_MacOSXNotifierAddRunLoopMode(
    const void *runLoopMode)
{
    Tcl_Panic("TclMacOSXNotifierAddRunLoopMode: "
    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

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

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

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

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

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 (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2000 by Ajuba Solutions
# 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 Tcl 8.5-
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

1
2
3
4
5
6



7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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 (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 © 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} {set i [expr $i+1]} {
    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

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} {set i [expr $i+1]} {
	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

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

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]} {
	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

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]} {
    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

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

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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

1
2
3
4
5
6



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.
# 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 Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testasync [llength [info commands testasync]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
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

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

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

1
2
3
4
5
6
7
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.
# 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 Tcltest [info patchlevel]]
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

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

1
2
3
4
5
6


7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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 (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
		ieeeValues(-Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
	    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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
		ieeeValues(+Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
		ieeeValues(+Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
	    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 \
	    binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Infinity)
	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
	    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 \
	    binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Normal)
	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
	    binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Infinity)
	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
	    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

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
} \x4C
test binary-4.5 {Tcl_BinaryObjCmd: format} {
    binary format B8 01001101
} \x4d
} \x4D
test binary-4.6 {Tcl_BinaryObjCmd: format} {
    binary format A2X2B9 oo 01001101
} \x4d\x00
} \x4D\x00
test binary-4.7 {Tcl_BinaryObjCmd: format} {
    binary format B9 010011011010
} \x4d\x80
} \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

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
} \xB2
test binary-5.6 {Tcl_BinaryObjCmd: format} {
    binary format A2X2b9 oo 01001101
} \xb2\x00
} \xB2\x00
test binary-5.7 {Tcl_BinaryObjCmd: format} {
    binary format b9 010011011010
} \xb2\x01
} \xB2\x01
test binary-5.8 {Tcl_BinaryObjCmd: format} {
    binary format b17 1
} \x01\00\00
} \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
} \x0C
test binary-6.5 {Tcl_BinaryObjCmd: format} {
    binary format h* baadf00d
} \xab\xda\x0f\xd0
} \xAB\xDA\x0F\xD0
test binary-6.6 {Tcl_BinaryObjCmd: format} {
    binary format h4 c410
} \x4c\x01
} \x4C\x01
test binary-6.7 {Tcl_BinaryObjCmd: format} {
    binary format h6 c4102
} \x4c\x01\x02
} \x4C\x01\x02
test binary-6.8 {Tcl_BinaryObjCmd: format} {
    binary format h5 c41020304
} \x4c\x01\x02
} \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

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
} \xC0
test binary-7.5 {Tcl_BinaryObjCmd: format} {
    binary format H* baadf00d
} \xba\xad\xf0\x0d
} \xBA\xAD\xF0\x0D
test binary-7.6 {Tcl_BinaryObjCmd: format} {
    binary format H4 c410
} \xc4\x10
} \xC4\x10
test binary-7.7 {Tcl_BinaryObjCmd: format} {
    binary format H6 c4102
} \xc4\x10\x20
} \xC4\x10\x20
test binary-7.8 {Tcl_BinaryObjCmd: format} {
    binary format H5 c41023304
} \xc4\x10\x20
} \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

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
} \x3F\xCC\xCC\xCD
test binary-13.5 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f 1.6
} \xcd\xcc\xcc\x3f
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \xFF\x7F\xFF\xFF
test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian {
    binary format f -3.402825e+38
} \xff\xff\x7f\xff
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \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

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

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

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

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

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
} \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
} \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
} \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
} \x01\xCD\xCC\xCC\x3F

test binary-39.1 {ScanNumber: sign extension} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 c2 arg1] $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
    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
    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
    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

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

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* \u20ac
} \u00ac
    binary format a* €
} \xAC
test binary-46.2 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    list [binary scan [binary format a* \u20ac\u20bd] s x] $x
    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* \u20ac\u20bd] aaa x y z] $x $y $z
} "2 \u00ac \u00bd {}"
    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 \u20ac]
    set x [encoding convertto iso8859-15 €]
    set y [binary format a* $x]
    list $x $y
} "\u00a4 \u00a4"
} "\xA4 \xA4"
test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    set x [binary scan \u00a4 a* y]
    set x [binary scan \xA4 a* y]
    list $x $y [encoding convertfrom iso8859-15 $y]
} "1 \u00a4 \u20ac"
} "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

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
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \x3F\xCC\xCC\xCD
test binary-53.5 {Tcl_BinaryObjCmd: format} {} {
    binary format r 1.6
} \xcd\xcc\xcc\x3f
} \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
} \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
} \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
} \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
} \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
} \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
} \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
} \xFF\x7F\xFF\xFF
test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} {
    binary format r -3.402825e+38
} \xff\xff\x7f\xff
} \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
} \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
} \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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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)
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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)
    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
    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
    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

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 \0\1\2\3\4\0\1\2\3\4
    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 "\0\1\2\3\4\0\1\2\3\4"
} -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

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 \0\1\2\3\4\0\1\2\3
    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 \0
    binary encode base64 \x00
} -result {AA==}
test binary-72.7 {binary encode base64} -body {
    binary encode base64 \0\0
    binary encode base64 \x00\x00
} -result {AAA=}
test binary-72.8 {binary encode base64} -body {
    binary encode base64 \0\0\0
    binary encode base64 \x00\x00\x00
} -result {AAAA}
test binary-72.9 {binary encode base64} -body {
    binary encode base64 \0\0\0\0
    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

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]
    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"
} -result "\x00\x01\x02\x03\x04\x00\x01\x02\x03"
test binary-73.6 {binary decode base64} -body {
    binary decode base64 AA==
} -result "\0"
} -result "\x00"
test binary-73.7 {binary decode base64} -body {
    binary decode base64 AAA=
} -result "\0\0"
} -result "\x00\x00"
test binary-73.8 {binary decode base64} -body {
    binary decode base64 AAAA
} -result "\0\0\0"
} -result "\x00\x00\x00"
test binary-73.9 {binary decode base64} -body {
    binary decode base64 AAAAAA==
} -result "\0\0\0\0"
} -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

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 \0\1\2\3\4\0\1\2\3
    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 \0\0
    binary encode uuencode \x00\x00
} -result "\"```
"
test binary-74.8 {binary encode uuencode} -body {
    binary encode uuencode \0\0\0
    binary encode uuencode \x00\x00\x00
} -result {#````
}
test binary-74.9 {binary encode uuencode} -body {
    binary encode uuencode \0\0\0\0
    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

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 "\0\1\2\3\4\0\1\2\3"
} -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

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 \u0141 B C] 1
    testsetbytearraylength [string cat Ł 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)"
    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 '\u4E4E' (U+004E4E)"
} -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 '\u4E4E' (U+004E4E)"
} -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

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

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
    chan configure stdout -eofchar Ā
} -returnCodes error -match glob -result {bad value*}
test chan-4.3 {chan command: [Bug 800753]} -body {
    chan configure stdout -eofchar \u0000
    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

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

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 Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
	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 {
    testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
	$::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

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

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\u4e4d\0"
    chan puts -nonewline $f "a乍\x00"
    chan close $f
    contents $path(test1)
} "a\x4d\x00"
} "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\u4e4d\0"
    chan puts -nonewline $f "a乍\x00"
    chan close $f
    contents $path(test1)
} "a\x93\xe1\x00"
} "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"
} "    \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

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 \uff21 in UTF-8). Given those two bytes try
    # (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 \uff21 plus the all of \uff22) appended.
    # 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 "12345678901234\uff21\uff22"
    chan puts -nonewline $f "12345678901234ＡＢ"
    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

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\0"
    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 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"]
} -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

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 puts $f "abcdef\x1Aghijk\nwombat"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -eofchar \x1a
    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 puts $f "abcdefghijk\nwom\x1Abat"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -eofchar \x1a
    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

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

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

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 puts -nonewline $f "123456\x1Ak9012345\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -eofchar \x1a
    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

1012
1013
1014
1015
1016
1017
1018

1019
1020
1021
1022
1023
1024
1025

1026
1027
1028
1029
1030
1031
1032
1033








-
+






-
+








} -cleanup {
    chan close $f
} -result {3 abc 1}
test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
    # Tcl_ExternalToUtf(), make sure state updated
    set f [open $path(test1) w]
    chan configure $f -encoding iso2022-jp
    chan puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
    chan puts $f "there一ok\n丁more bytes\nhere"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding iso2022-jp
    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
} -result [list 8 "there一ok" 11 "丁more bytes" 4 "here"]
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
    update
    variable x {}
} -constraints {stdio fileevent} -body {
    set f [openpipe w+ $path(cat)]
    chan configure $f -buffering none
    chan puts -nonewline $f "foobar"




︙


1052
1053
1054
1055
1056
1057
1058
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

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 "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
    chan puts $f "1234567890123０１２３４\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"
} -result "1234567890123０１２３４"
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 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 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 ""]
} -result [list 15 "1234567890123０１" 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 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]
} -result [list -1 "" 1 17 "1234567890123０１２３" 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

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

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"
    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]
} -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 "\xE7"
	chan gets stdin; chan puts -nonewline "\x89"
	chan gets stdin; chan puts -nonewline "\xa6"
	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

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 \u7266 {} eof 0 {}"
} -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

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 != '\0')
    # (*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 != '\0')
    # (*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

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}]
} -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 {
} -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

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 knownMsvcBug} -body {
} -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

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

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 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 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 -eofchar \x1a -translation lf
    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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation auto
    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

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"
} -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 [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 [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
    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
    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
    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
    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
    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
    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

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
    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 -eofchar \x1a -translation lf
    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 -eofchar \x1a -translation auto
    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 -eofchar \x1a
    chan configure $f -translation auto
    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 -eofchar \x1a -translation auto
    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

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

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

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

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

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

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

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]
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format "%#o" [expr $stats(mode)&0o777]]
    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 "%#o" [expr $stats(mode)&0o777]
} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
    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

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"
    chan event $f r "first scr\x00ipt"
    lappend result [string length [chan event $f readable]]
    chan event $f r "new scr\0ipt"
    chan event $f r "new scr\x00ipt"
    lappend result [string length [chan event $f readable]]
    chan event $f r "yet ano\0ther"
    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

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

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

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

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

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

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

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

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

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

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

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

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

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]
	    set mode [testservicemode 1]
	    vwait z
	    after cancel $timer
	    test servicemode $mode
	    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

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

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

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

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

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

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

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

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

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
    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
    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]"}
	  "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]"}
	  "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

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

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
	    1872-12-31 西暦1872年12月31日
	    1873-01-01 明治06年01月01日
	    1912-07-29 明治45年07月29日
	    1912-07-30 大正01年07月30日
	    1926-12-24 大正15年12月24日
	    1926-12-25 昭和01年12月25日
	    1989-01-07 昭和64年01月07日
	    1989-01-08 平成01年01月08日
	    2019-04-30 平成31年04月30日
	    2019-05-01 令和01年05月01日
	} {
	    set status [catch {
		set secs [clock scan $date \
			      -timezone +0900 \
			      -locale ja_JP \
			      -format %Y-%m-%d]
		set jda [clock format $secs \




︙


36926
36927
36928
36929
36930
36931
36932
36933

36934
36935
36936

36937
36938
36939
36940
36941
36942
36943

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]
} [expr {0x7fffffffffffffff}]
test clock-61.4 {near-miss overflow of a wide integer on output} {
    clock format -0x8000000000000000 -format %s -gmt true
} [expr -0x8000000000000000]
} [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

1
2
3
4
5
6


7
8
9
10
11
12
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.
# 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 Tcltest [info patchlevel]]
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 {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
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

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
    cd .\x00
} -cleanup {
    cd $dir
} -match glob -result "couldn't change working directory to \".\0\": *"
} -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

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
    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 \u4e4e
    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 \u4e4e
} -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 \u4e4e
} -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

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 attributes /tmp/tcl.foo.dir -permissions 0
    file exists /tmp/tcl.foo.dir/file
} -cleanup {
    file attributes /tmp/tcl.foo.dir -permissions 0775
    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

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

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

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

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

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

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

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

1
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.
# 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 Tcltest [info patchlevel]]
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

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]
    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 \0 \x7f \x80 \uffff]
} [list \0 \x7f \x80 \uffff]
    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 \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \x7f \x80 \uffff \U01ffff]
    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 \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \x7f \x80 \uffff \U01ffff]
    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)}]
	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

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"]
    set result [lsort -dictionary "a b c A B C ã Ä"]
    ::tcltest::restore_locale
    set result
} "A a B b C c \xe3 \xc4"
} "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\xe3 a23\xc5 a23\xe4"]
    set result [lsort -dictionary "a23ã a23Å a23ä"]
    ::tcltest::restore_locale
    set result
} "a23\xe3 a23\xe4 a23\xc5"
} "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

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
    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\u0000a]] %c%c%c%c%c
    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

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

1
2
3
4
5
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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 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\000c4" ab\000c
    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\xe5 {} N wq"
    split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
} "a b qw\u5e4eN wq"
    # if not UTF-8 aware, result is "a {} {} b qwå {} N wq"
    split "a乎b qw幎N wq" " 乎"
} "a b qw幎N wq"

# The tests for Tcl_StringObjCmd are in string.test
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test

# todo: rewrite this if monotonic clock is provided resp. command "after"
# gets microsecond accuracy (RFE [fdfbd5e10] gets merged):




︙







Changes to tests/compExpr-old.test.



1
2
3
4
5
6
7
8
9
10


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

1
2
3
4
5
6
7
8


9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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.
# 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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
		ieeeValues(-Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
	    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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
		ieeeValues(+Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
		ieeeValues(+Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
	    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 \
	    binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Infinity)
	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
	    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 \
	    binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Normal)
	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
	    binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Infinity)
	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
	    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

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

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

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

1
2
3
4
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.
# 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 Tcltest [info patchlevel]]
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

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] {} {
    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

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] {
    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
    list [catch "string length \x00foo" msg] $msg
} {0 4}
test compile-8.2 {CollectArgInfo: binary data} {
    list [catch "string length foo\000" msg] $msg
    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

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

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

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

1
2
3
4
5
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.
# 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} {
test pkgconfig-1.1 {query keys} -body {
    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}
} -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

1
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.
# 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 Tcltest [info patchlevel]]
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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

1
2
3
4


5
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.
# 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 Tcltest [info patchlevel]
    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

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] \
    list [encoding convertto jis0208 乎] \
	[encoding convertfrom jis0208 8C]
} "8C \u4e4e"
} "8C 乎"

test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
    encoding convertto jis0208 \u4e4e
    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 \u4e4e]	;# old one found
    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 \u4e4e} msg] $msg
    lappend x [catch {encoding convertto shiftjis 乎} msg] $msg
} -cleanup {
    encoding system iso8859-1
    encoding dirs $path
    encoding system $system
} -result "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
} -result "\x8C\xC1 1 {unknown encoding \"shiftjis\"}"

test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup {
    set old [encoding system]
} -body {
    encoding system shiftjis
    encoding system
} -cleanup {




︙


133
134
135
136
137
138
139
140

141
142
143
144
145
146
147

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

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
} "\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"
} "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"
    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"
} "ab乎g"

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
    encoding convertto jis0208 "\u543e\u543e\u543e\u543e"
    encoding convertto jis0208 "吾吾吾吾"
} {8c8c8c8c}
test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
    set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e
    set a 乎乎乎乎乎乎乎乎
    append a $a
    append a $a
    append a $a
    append a $a
    append a $a
    append a $a
    set x [encoding convertto jis0208 $a]
    list [string length $x] [string range $x 0 1]
} "1024 8C"

test encoding-10.1 {Tcl_UtfToExternal} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation binary -encoding shiftjis
    puts -nonewline $f "ab\u4e4eg"
    puts -nonewline $f "ab乎g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding iso8859-1
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\x8c\xc1g"
} "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]]"
	    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]
    set x [list [catch {encoding convertto jis0208 乎} msg] $msg]
    encoding dirs $path
    encoding system $system
    lappend x [encoding convertto jis0208 \u4e4e]
    lappend x [encoding convertto jis0208 乎]
} {1 {unknown encoding "jis0208"} 8C}
test encoding-11.2 {LoadEncodingFile: single-byte} {
    encoding convertfrom jis0201 \xa1
} "\uff61"
    encoding convertfrom jis0201 \xA1
} "｡"
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"
    encoding convertfrom shiftjis \x8C\xC1
} 乎
test encoding-11.5 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022 \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
    viewable [encoding convertto iso2022 乎]
} [viewable "\x1B\$B8C\x1B(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022-jp \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
    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 \u4e4e
    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 \u0120]
    append x [encoding convertto iso8859-3 \xD5]
    append x [encoding convertfrom iso8859-3 \xD5]
} "\xd5?\u120"
    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\u0120g]
    append x [encoding convertfrom iso8859-3 ab\xD5g]
} "ab\xd5gab\u120g"
    set x [encoding convertto iso8859-3 abĠg]
    append x [encoding convertfrom iso8859-3 abÕg]
} "abÕgabĠg"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
    set x [encoding convertto shiftjis ab\u4E4Eg]
    append x [encoding convertfrom shiftjis ab\x8c\xc1g]
} "ab\x8c\xc1gab\u4e4eg"
    set x [encoding convertto shiftjis ab乎g]
    append x [encoding convertfrom shiftjis ab\x8C\xC1g]
} "ab\x8C\xC1gab乎g"
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
    set x [encoding convertto jis0208 \u4e4e\u3b1]
    set x [encoding convertto jis0208 乎α]
    append x [encoding convertfrom jis0208 8C&A]
} "8C&A\u4e4e\u3b1"
} "8C&A乎α"
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"
    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\u4e4e\u68d9g]]
} [viewable "ab\x1b\$B8C\x1b\$\(DD%\x1b(Bg"]
    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 \xa3
} "\xc2\xa3"
    encoding convertto utf-8 £
} "\xC2\xA3"
test encoding-15.2 {UtfToUtfProc null character output} testbytestring {
    binary scan [testbytestring [encoding convertto utf-8 \u0000]] H* z
    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 \u0000]]
    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 \U1F602"
} -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 \U1F602"
} "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\xE9
    set y [encoding convertto utf-8 \uDE02\uD83D\xE9]
    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\xE9
    set y [encoding convertto utf-8 \uDE02\xE9]
    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\xE9
    set y [encoding convertto utf-8 \uDA02\xE9]
    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

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 \U1F602
    set y [encoding convertto utf-8 \U1F602]
    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 "\u4E4E 4e4e"
} -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 "\u4E4E 4e4e"
} -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

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 "\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 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 "\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
set iso2022uniData2 "私どもでは、チップご購入時にご登録いただいたご住所をキャッシュアウトの際の
\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
小切手送付先として使用しております。恐れ入りますが、正しい住所をご登録しなお
お願いいたします。また、大変恐縮ですが、住所変更のあと、日本語サービス部（
casino_japanese@___.com ）までご住所変更済の連絡をいただけないで
\u3057\u3087\u3046\u304b\uff1f"
しょうか？"

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

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\u4e4e\u68d9g
	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)"
} "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
	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 (\\u4e4e\\u4e5e\\u4e5f)"]
} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"]

test encoding-24.4 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xc0\x80"]
    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"]
    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"]
    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"]
    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"]
    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"]
    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"]
    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"]
    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

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}]
	[expr {($code >> 8) | 0x80}] [expr {($code & 0xFF) | 0x80}]
}
proc gen-jisx0208-iso2022-jp {code} {
    binary format a3cca3 \
	"\x1b\$B" [expr {$code >> 8}] [expr {$code & 0xff}] "\x1b(B"
	"\x1B\$B" [expr {$code >> 8}] [expr {$code & 0xFF}] "\x1B(B"
}
proc gen-jisx0208-cp932 {code} {
    set c1 [expr {($code >> 8) | 0x80}]
    set c2 [expr {($code & 0xff)| 0x80}]
    if {$c1 % 2} {
	set c1 [expr {($c1 >> 1) + ($c1 < 0xdf ? 0x31 : 0x71)}]
	incr c2 [expr {- (0x60 + ($c2 < 0xe0))}]
	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)}]
	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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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

1
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.
# 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 Tcltest [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    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

1
2
3
4
5
6



7
8
9
10
11
12
13
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 (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 © 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 Tcltest [info patchlevel]]
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 noosx [expr {![info exists ::env(TRAVIS_OSX_IMAGE)] || ![string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]
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

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

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 "\[\u007f-\uffff\]" $s \
	    {[apply {c {format {\u%04x} [scan $c %c]}} &]} 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: "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1"
    # 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) << "\uE9\uE0\uFC\uF1"]
    quotenonascii [exec [interpreter] $path(cat) << "\xE9\xE0\xFC\xF1"]
} -cleanup {
    encoding system $sysenc
    rename quotenonascii {}
} -result {\u00e9\u00e0\u00fc\u00f1}
} -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

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 noosx} -setup {
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

1
2
3
4
5
6
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.
# 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 Tcltest [info patchlevel]]
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

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
    expr {wide(42) << 30}
} 45097156608
test execute-7.12 {Wide int handling in INST_LSHIFT} {
    expr 12345678901<<3
    expr {12345678901 << 3}
} 98765431208
test execute-7.13 {Wide int handling in INST_RSHIFT} {
    expr 0x543210febcda9876>>7
    expr {0x543210febcda9876 >> 7}
} 47397893236700464
test execute-7.14 {Wide int handling in INST_RSHIFT} {
    expr wide(0x9876543210febcda)>>7
    expr {wide(0x9876543210febcda) >> 7}
} -58286587177206407
test execute-7.15 {Wide int handling in INST_BITOR} {
    expr wide(0x9876543210febcda) | 0x543210febcda9876
    expr {wide(0x9876543210febcda) | 0x543210febcda9876}
} -2560765885044310786
test execute-7.16 {Wide int handling in INST_BITXOR} {
    expr wide(0x9876543210febcda) ^ 0x543210febcda9876
    expr {wide(0x9876543210febcda) ^ 0x543210febcda9876}
} -3727778945703861076
test execute-7.17 {Wide int handling in INST_BITAND} {
    expr wide(0x9876543210febcda) & 0x543210febcda9876
    expr {wide(0x9876543210febcda) & 0x543210febcda9876}
} 1167013060659550290
test execute-7.18 {Wide int handling in INST_ADD} {
    expr wide(0x7fffffff)+wide(0x7fffffff)
    expr {wide(0x7fffffff) + wide(0x7fffffff)}
} 4294967294
test execute-7.19 {Wide int handling in INST_ADD} {
    expr 0x7fffffff+wide(0x7fffffff)
    expr {0x7fffffff + wide(0x7fffffff)}
} 4294967294
test execute-7.20 {Wide int handling in INST_ADD} {
    expr wide(0x7fffffff)+0x7fffffff
    expr {wide(0x7fffffff) + 0x7fffffff}
} 4294967294
test execute-7.21 {Wide int handling in INST_ADD} {
    expr double(0x7fffffff)+wide(0x7fffffff)
    expr {double(0x7fffffff) + wide(0x7fffffff)}
} 4294967294.0
test execute-7.22 {Wide int handling in INST_ADD} {
    expr wide(0x7fffffff)+double(0x7fffffff)
    expr {wide(0x7fffffff) + double(0x7fffffff)}
} 4294967294.0
test execute-7.23 {Wide int handling in INST_SUB} {
    expr 0x123456789a-0x20406080a
    expr {0x123456789a - 0x20406080a}
} 69530054800
test execute-7.24 {Wide int handling in INST_MULT} {
    expr 0x123456789a*193
    expr {0x123456789a * 193}
} 15090186251290
test execute-7.25 {Wide int handling in INST_DIV} {
    expr 0x123456789a/193
    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

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

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

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

1
2
3
4
5
6
7
8



9
10
11
12
13
14
15
16
17
18
19
20
21

22
23
24
25
26
27
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.
# 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 Tcltest [info patchlevel]]
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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
		ieeeValues(-Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
	    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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
		ieeeValues(+Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
		ieeeValues(+Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
	    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 \
	    binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Infinity)
	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
	    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 \
	    binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Normal)
	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
	    binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Infinity)
	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
	    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

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

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

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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
		ieeeValues(-Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
	    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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
		ieeeValues(+Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
		ieeeValues(+Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
		ieeeValues(NaN)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \
	    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 \
	    binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Infinity)
	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
	    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 \
	    binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Normal)
	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
	    binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Infinity)
	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
	    binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(NaN)
	    binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \
	    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

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

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

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

1
2
3
4
5
6


7
8
9
10
11
12
13
14
15
16
17
18

19
20
21
22
23
24

25

26
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 (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
# 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 Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

cd [temporaryDirectory]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
testConstraint winLessThan10 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)]}]
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

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]} {
if {[testConstraint win] && $::tcl_platform(osVersion) < 10.0} {
    if {$::tcl_platform(osVersion) >= 5.0} {
	testConstraint winVista 1
    testConstraint winLessThan10 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 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

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] == '\0'} -setup {
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

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 == '\0'} -setup {
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

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 0000
    file attributes td1 -permissions 0
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1 -permissions 0755
    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 0000
    file attributes $td1name -permissions 0
    file copy ~/td1 td1
} -returnCodes error -cleanup {
    file attributes $td1name -permissions 0755
    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 0000
    file attributes $td1name -permissions 0
    file copy td2 ~/td1
} -returnCodes error -cleanup {
    file attributes $td1name -permissions 0755
    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 0000
    file attributes $td2name -permissions 0
    file copy ~/td1 td1
} -returnCodes error -cleanup {
    file attributes $td2name -permissions 0755
    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 0000
    file attributes td1/td2/td3 -permissions 0
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1/td2/td3 -permissions 0755
    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

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.a {file rename: comprehensive: dir to new name} -setup {
test fCmd-9.4 {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 {
test fCmd-9.6 {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 .




︙


904
905
906
907
908
909
910
911
912
913
914
915
916
917

918
919
920
921
922
923
924
925
926
927

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




︙


935
936
937
938
939
940
941
942
943
944
945
946
947
948

949
950
951
952
953
954
955
956
957
958

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




︙


1337
1338
1339
1340
1341
1342
1343
1344

1345
1346
1347

1348
1349
1350
1351
1352
1353
1354

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 0555
    file attributes tfa -permissions 0o555
    catch {file rename tfa/dir tfa2}
} -cleanup {
    catch {file attributes tfa -permissions 0777}
    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

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 0000
    file attributes tfa/dir -permissions 0
    catch {file copy tfa tfa2}
} -cleanup {
    file attributes tfa/dir -permissions 0777
    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

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 0000
    file attributes tfa -permissions 0
    catch {file mkdir tfa/file}
} -cleanup {
    file attributes tfa -permissions 0777
    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

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

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 0555
     file attributes tfa1 -permissions 0o555
     catch {file mkdir tfa1/tfa2}
} -cleanup {
     file attributes tfa1 -permissions 0777
     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

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 0555
    file attributes tfa -permissions 0o555
    catch {file delete tfa/a}
} -cleanup {
    file attributes tfa -permissions 0777
    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

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 0000
    file attributes tfa/a -permissions 00000
    catch {file delete -force tfa}
} -cleanup {
    file attributes tfa/a -permissions 0777
    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

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 win} -setup {
test fCmd-28.8 {file link} -constraints {linkFile winLessThan10} -setup {
    cd [temporaryDirectory]
} -body {
    file link -symbolic abc.link abc.file
} -returnCodes error -cleanup {
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {could not create new link "abc.link" pointing to "abc.file": not a directory}
} -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

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 notWine} -body {
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

1
2
3
4
5
6


7
8
9
10
11
12
13
14
15
16
17
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.
# 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 Tcltest [info patchlevel]]
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 {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
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

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 *]
	set res1 [glob -dir [lindex [file volumes] end] -tails *]
    }
    catch {
	cd [lindex [file volumes] 0]
	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

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

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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 (c) 2002 Vincent Darley.
# 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 Tcltest [info patchlevel]
    package require -exact tcl::test [info patchlevel]
    set ::ddever [package require dde]
    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]
    set ::ddelib [info loaded {} Dde]
    set ::regver  [package require registry]
    set ::reglib [lindex [package ifneeded registry $::regver] 1]
    testConstraint loaddll 1
    set ::reglib [info loaded {} Registry]
    testConstraint loaddll [expr {$::ddelib ne "" && $::reglib ne ""}]
}

# Test for commands defined in Tcltest executable
# 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 knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
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

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

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 knownMsvcBug} -body {
} -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

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

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

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
# 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 \u767b\u9e1b\u9d72\u6a13
    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

1
2
3
4
5
6
7
8


9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
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.
# 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} {set i [expr $i+1]} {
    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} {set i [expr $i+1]} {
	if $i==4 continue
    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} {set i [expr $i+1]} {
	if $i==4 break
    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} {set i [expr $i+1]} {}
    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} {set i [expr $i+1]; if $i==4 break} {
    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

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

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
    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} {set i [expr $i+1]} "append a x"
    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} {set i [expr $i+1]} $x1$bb$x2
    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} {set i [expr $i+1]} {
	if $i==4 break
	if $i>5 continue
    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

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 [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]} {
    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} {set i [expr $i+1]} {
    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} {set i [expr $i+1]} {
	if $i==2 continue
	if $i==4 break
	if $i>5 continue
    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

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

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

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 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} {
	    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]
		    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

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

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
    $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} {set i [expr $i+1]} "append a x"
    $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} {set i [expr $i+1]} $x1$bb$x2
    $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} {set i [expr $i+1]} {
	if $i==4 break
	if $i>5 continue
    $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

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

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

1
2
3
4
5
6


7
8
9
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 (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
# 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(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
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

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\0def
} "   abc\0def"
    format "%10s" abc\x00def
} "   abc\x00def"
test format-2.6 {string formatting, international chars} {
    format "%10s" abc\ufeffdef
} "   abc\ufeffdef"
    format "%10s" abc\uFEFFdef
} "   abc\uFEFFdef"
test format-2.7 {string formatting, international chars} {
    format "%.5s" abc\ufeffdef
} "abc\ufeffd"
    format "%.5s" abc\uFEFFdef
} "abc\uFEFFd"
test format-2.8 {string formatting, international chars} {
    format "foo\ufeffbar%s" baz
} "foo\ufeffbarbaz"
    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

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
} "|\ua2|\u4e4e|\u25a|\uc3|\uff08     |     \0|  \u6575|\u4e4f   |"
    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

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

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

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

1
2
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.
# 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 Tcltest [info patchlevel]]
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

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 } {
    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 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"}}
} {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

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

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]} \
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

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

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

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

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

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

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
}

if {$::tcl_platform(os) eq "Darwin"} {
    # Name resolution often a problem on OSX; not focus of HTTP package anyway
    set HOST localhost
# 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
} else {
    set HOST [info hostname]
}

set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
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

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

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 \xa1\xa2\xa2
    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 \xa1\xa2\xa2]
    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

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 "\u2208"
    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 "\u2208"
    http::mapReply "∈"
} -cleanup {
    http::config -urlencoding $enc
} -result "can't read \"formMap(\u2208)\": no such element in array"
} -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 "\u2208"
    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

711
712
713
714
715
716
717

718
719
720
721
722
723

724
725
726
727
728
729

730
731
732
733
734
735

736
737
738
739
740
741

742
743
744
745
746
747

748
749
750
751
752
753
754
755








-
+





-
+





-
+





-
+





-
+





-
+








    ::tcl::idna encode
} -result {wrong # args: should be "::tcl::idna encode hostname"}

test http-idna-2.1 {puny encode: functional test} {
    ::tcl::idna puny encode abc
} abc-
test http-idna-2.2 {puny encode: functional test} {
    ::tcl::idna puny encode a\u20acb\u20acc
    ::tcl::idna puny encode a€b€c
} abc-k50ab
test http-idna-2.3 {puny encode: functional test} {
    ::tcl::idna puny encode ABC
} ABC-
test http-idna-2.4 {puny encode: functional test} {
    ::tcl::idna puny encode A\u20ACB\u20ACC
    ::tcl::idna puny encode A€B€C
} ABC-k50ab
test http-idna-2.5 {puny encode: functional test} {
    ::tcl::idna puny encode ABC 0
} abc-
test http-idna-2.6 {puny encode: functional test} {
    ::tcl::idna puny encode A\u20ACB\u20ACC 0
    ::tcl::idna puny encode A€B€C 0
} abc-k50ab
test http-idna-2.7 {puny encode: functional test} {
    ::tcl::idna puny encode ABC 1
} ABC-
test http-idna-2.8 {puny encode: functional test} {
    ::tcl::idna puny encode A\u20ACB\u20ACC 1
    ::tcl::idna puny encode A€B€C 1
} ABC-k50ab
test http-idna-2.9 {puny encode: functional test} {
    ::tcl::idna puny encode abc 0
} abc-
test http-idna-2.10 {puny encode: functional test} {
    ::tcl::idna puny encode a\u20ACb\u20ACc 0
    ::tcl::idna puny encode a€b€c 0
} abc-k50ab
test http-idna-2.11 {puny encode: functional test} {
    ::tcl::idna puny encode abc 1
} ABC-
test http-idna-2.12 {puny encode: functional test} {
    ::tcl::idna puny encode a\u20ACb\u20ACc 1
    ::tcl::idna puny encode a€b€c 1
} ABC-k50ab
test http-idna-2.13 {puny encode: edge cases} {
    ::tcl::idna puny encode ""
} ""
test http-idna-2.14-A {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644




︙


874
875
876
877
878
879
880
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

871
872
873
874
875
876
877

878
879
880
881
882
883

884
885
886

887
888
889

890
891
892
893
894
895

896
897
898
899
900
901

902
903
904
905
906
907

908
909
910
911
912
913

914
915
916
917
918
919
920
921








-
+





-
+


-
+


-
+





-
+





-
+





-
+





-
+








} {-> $1.00 <--}

test http-idna-3.1 {puny decode: functional test} {
    ::tcl::idna puny decode abc-
} abc
test http-idna-3.2 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab
} a\u20acb\u20acc
} a€b€c
test http-idna-3.3 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-
} ABC
test http-idna-3.4 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-k50ab
} A\u20ACB\u20ACC
} A€B€C
test http-idna-3.5 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB
} A\u20ACB\u20ACC
} A€B€C
test http-idna-3.6 {puny decode: functional test} {
    ::tcl::idna puny decode abc-K50AB
} a\u20ACb\u20ACc
} a€b€c
test http-idna-3.7 {puny decode: functional test} {
    ::tcl::idna puny decode ABC- 0
} abc
test http-idna-3.8 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB 0
} a\u20ACb\u20ACc
} a€b€c
test http-idna-3.9 {puny decode: functional test} {
    ::tcl::idna puny decode ABC- 1
} ABC
test http-idna-3.10 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB 1
} A\u20ACB\u20ACC
} A€B€C
test http-idna-3.11 {puny decode: functional test} {
    ::tcl::idna puny decode abc- 0
} abc
test http-idna-3.12 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab 0
} a\u20ACb\u20ACc
} a€b€c
test http-idna-3.13 {puny decode: functional test} {
    ::tcl::idna puny decode abc- 1
} ABC
test http-idna-3.14 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab 1
} A\u20ACB\u20ACC
} A€B€C
test http-idna-3.15 {puny decode: edge cases and errors} {
    # Is this case actually correct?
    binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]]
} c282c281c280
test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body {
    ::tcl::idna puny decode abc!
} -result {bad decode character "!"}




︙


1044
1045
1046
1047
1048
1049
1050
1051

1052
1053
1054

1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067

1041
1042
1043
1044
1045
1046
1047

1048
1049
1050

1051
1052
1053
1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1064








-
+


-
+





-
+








} {-> $1.00 <-}
rename hexify ""

test http-idna-4.1 {IDNA encoding} {
    ::tcl::idna encode abc.def
} abc.def
test http-idna-4.2 {IDNA encoding} {
    ::tcl::idna encode a\u20acb\u20acc.def
    ::tcl::idna encode a€b€c.def
} xn--abc-k50ab.def
test http-idna-4.3 {IDNA encoding} {
    ::tcl::idna encode def.a\u20acb\u20acc
    ::tcl::idna encode def.a€b€c
} def.xn--abc-k50ab
test http-idna-4.4 {IDNA encoding} {
    ::tcl::idna encode ABC.DEF
} ABC.DEF
test http-idna-4.5 {IDNA encoding} {
    ::tcl::idna encode A\u20acB\u20acC.def
    ::tcl::idna encode A€B€C.def
} xn--ABC-k50ab.def
test http-idna-4.6 {IDNA encoding: invalid edge case} {
    # Should this be an error?
    ::tcl::idna encode abc..def
} abc..def
test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body {
    ::tcl::idna encode abc.$.def




︙


1083
1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097

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\u00e9.example.com
    ::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

1
2
3
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 (c) 2014 Donal K. Fellows.
# 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 notOSXtravis [apply {{} {
testConstraint notMacCI [expr {![info exists ::env(MAC_CI)]}]
    upvar 1 env(TRAVIS_OSX_IMAGE) travis
    return [expr {![info exists travis] || ![string match xcode* $travis]}]
}}]
testConstraint sqlite3 [expr {[testConstraint notOSXtravis] && ![catch {
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

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 (c) 1997-1998 Sun Microsystems, Inc.
# Copyright (c) 1999-2000 Scriptics Corporation
# 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

if {$::tcl_platform(os) eq "Darwin"} {
    # Name resolution often a problem on OSX; not focus of HTTP package anyway
    set HOST localhost
# 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
} 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]




︙







Changes to tests/httpd11.tcl.



1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18











-
+








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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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.
# 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 Tcltest [info patchlevel]]
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

1
2
3
4
5
6
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
# 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 Tcltest [info patchlevel]]
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

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

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

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

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

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

1
2
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.
# 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 Tcltest [info patchlevel]]
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

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

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
    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 {proc foo {} {expr {3 + 5}}}
    a eval foo
} 8
catch {a eval {proc foo {} {expr 3 + 5}}}
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} {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

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

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

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

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

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

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 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}]
	    $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

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

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}]"
    $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

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

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}
} -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
} -returnCodes error -result {milliseconds must be at least 0}
} -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

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

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

27
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 Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
	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 {
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
    $::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

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

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\u4e4d\0"
    puts -nonewline $f "a乍\x00"
    close $f
    contents $path(test1)
} "a\x4d\x00"
} "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"
    puts -nonewline $f "a乍\x00"
    close $f
    contents $path(test1)
} "a\x93\xe1\x00"
} "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"
} "    \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

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 \uff21 in UTF-8).  Given those two bytes try
    # (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 \uff21 plus the all of \uff22) appended.
    # (the last byte of Ａ plus the all of Ｂ) appended.

    set f [open $path(test1) w]
    fconfigure $f -encoding shiftjis -buffersize 16
    puts -nonewline $f "12345678901234\uff21\uff22"
    puts -nonewline $f "12345678901234ＡＢ"
    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

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\0"
    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"
    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"]
} [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

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"
    puts $f "abcdef\x1Aghijk\nwombat"
    close $f
    set f [open $path(test1)]
    fconfigure $f -eofchar \x1a
    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"
    puts $f "abcdefghijk\nwom\x1Abat"
    close $f
    set f [open $path(test1)]
    fconfigure $f -eofchar \x1a
    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

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

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

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"
    puts -nonewline $f "123456\x1Ak9012345\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -eofchar \x1a
    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

1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058
1059
1060
1061

1062
1063
1064
1065
1066
1067
1068
1069








-
+






-
+








    set x
} {3 abc 1}
test io-6.55 {Tcl_GetsObj: overconverted} {
    # Tcl_ExternalToUtf(), make sure state updated

    set f [open $path(test1) w]
    fconfigure $f -encoding iso2022-jp
    puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
    puts $f "there一ok\n丁more bytes\nhere"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding iso2022-jp
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
} [list 8 "there一ok" 11 "丁more bytes" 4 "here"]
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} {
    update
    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -buffering none
    puts -nonewline $f "foobar"
    fconfigure $f -blocking 0
    variable x {}




︙


1079
1080
1081
1082
1083
1084
1085
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

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 "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
    puts $f "1234567890123０１２３４\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"
} "1234567890123０１２３４"
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"
    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"
    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 ""]
} [list 15 "1234567890123０１" 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"
    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]
} [list -1 "" 1 17 "1234567890123０１２３" 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

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

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"
    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]
} [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 "\xE7"
	gets stdin; puts -nonewline "\x89"
	gets stdin; puts -nonewline "\xa6"
	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

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 \u7266 {} eof 0 {}"
} "{} 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 \uBEEF 20][string repeat . 20]]
                        [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

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 \uBEEF 10]....\uBEEF]
                        [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

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

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 != '\0')
    # (*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 != '\0')
    # (*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

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]
    lappend l [expr {[testchannel refcount stdin] - $l1}]
    x eval {eof stdin}
    lappend l [expr [testchannel refcount stdin] - $l1]
    lappend l [expr {[testchannel refcount stdin] - $l1}]
    interp delete x
    lappend l [expr [testchannel refcount stdin] - $l1]
    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]
    lappend l [expr {[testchannel refcount stdout] - $l1}]
    x eval {eof stdout}
    lappend l [expr [testchannel refcount stdout] - $l1]
    lappend l [expr {[testchannel refcount stdout] - $l1}]
    interp delete x
    lappend l [expr [testchannel refcount stdout] - $l1]
    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]
    lappend l [expr {[testchannel refcount stderr] - $l1}]
    x eval {eof stderr}
    lappend l [expr [testchannel refcount stderr] - $l1]
    lappend l [expr {[testchannel refcount stderr] - $l1}]
    interp delete x
    lappend l [expr [testchannel refcount stderr] - $l1]
    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

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}]
} [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

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

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 knownMsvcBug} {
	{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

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} {
test io-28.4 Tcl_Close testchannel {
    file delete $path(test1)
    set l ""
    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

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

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 knownMsvcBug} {
	{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

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]
} [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]
} [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
    puts -nonewline $f hello\nthere\nand\rhere\n\x1A
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation lf
    fconfigure $f -translation lf -eofchar \x1A
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation auto
    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

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"
} "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 [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 [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
    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
    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
    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
    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
    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
    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

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 -eofchar \x1a -translation auto
    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 -eofchar \x1a -translation lf
    fconfigure $f -translation lf -eofchar \x1A
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    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 -eofchar \x1a
    fconfigure $f -translation auto
    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 -eofchar \x1a -translation auto
    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

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

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

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

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]
} [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]
} [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

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

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

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

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




︙


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

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
    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
    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"
    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"
} "{} 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

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

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\0ipt"
    fileevent $f r "first scr\x00ipt"
    lappend result [string length [fileevent $f readable]]
    fileevent $f r "new scr\0ipt"
    fileevent $f r "new scr\x00ipt"
    lappend result [string length [fileevent $f readable]]
    fileevent $f r "yet ano\0ther"
    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

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

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 -eofchar \x1a -translation auto
    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

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

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 -eofchar \x1a -translation auto
    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

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

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 -eofchar \x1a -translation auto
    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

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 -eofchar \x1a -translation lf
    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

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

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 -eofchar \x1a -translation cr
    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

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

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 -eofchar \x1a -translation crlf
    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

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

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

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 "\u0410\u0410"
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

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 "\u0410\u0410"
    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

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

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

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 knownMsvcBug} {
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

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

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\u00c2\u00a0data"
    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\u00a0data 1]
} -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

1
2
3
4
5
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.
# 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 Tcltest [info patchlevel]]
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

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
    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
} \u0048
} 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

1
2
3
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]>
# 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 Tcltest [info patchlevel]]
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

1
2
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.
# 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 Tcltest [info patchlevel]]
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

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

1
2
3
4
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.
# 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 Tcltest [info patchlevel]]
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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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"
    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 "\0a\0b"
    set result "\x00a\x00b"
    list $result [string length $result]
} "\0a\0b 4"
} "\x00a\x00b 4"
test list-1.29 {basic null treatment} {
    set result "\0a\0b"
    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 "\0abc" "xyz"]
    set e "\0abc xyz"
    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

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]
    set last [expr {[llength $list] - 1}]
    while {$last > 0} {
	set minIndex [expr [llength $list] - 1]
	set minIndex [expr {[llength $list] - 1}]
	set min [lindex $list $last]
	set i [expr $minIndex-1]
	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]
	    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 list [concat [lrange $list 0 [expr {$minIndex - 1}]] \
			  [lrange $list [expr {$minIndex + 1}] end]]
	}
	set last [expr $last-1]
	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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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

1
2
3
4
5
6


7
8
9
10
11
12
13
14
15
16
17
18

19
20
21
22
23
24
25
26
27
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 (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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 Tcltest [info patchlevel]]
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 'teststaticpkg' command from tcltest
# Certain tests require the 'teststaticlibrary' command from tcltest

testConstraint teststaticpkg [llength [info commands teststaticpkg]]
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} {} {
    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-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
    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
    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}}
} {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] \
    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}}}
"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] \
    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}}}
"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
    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}
    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\""
    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} \
test load-5.1 {file name not specified and no static package: pick default} -setup {
	[list $dll $loaded] {
    catch {interp delete x}
    interp create x
} -constraints [list $dll $loaded] -body {
    load -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    set result [info loaded x]
    load -global [file join $testDir pkga$ext] Pkga
    load {} Pkga x
    info loaded x
} -cleanup {
    interp delete x
    set result
} [list [list [file join $testDir pkga$ext] Pkga]]
} -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] {
test load-7.1 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
    set x "not loaded"
    teststaticpkg Test 1 0
    teststaticlibrary 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] {
test load-7.2 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
    set x "not loaded"
    teststaticpkg Another 0 0
    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 package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
} {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"
    teststaticpkg More 0 1
    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 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
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} {*}$currentRealPackages {*}$alreadyTotalLoaded]
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealLibraries {*}$alreadyTotalLoaded]

testConstraint teststaticpkg_8.x \
    [if {[testConstraint teststaticpkg]} {
	teststaticpkg Test 1 1
	teststaticpkg Another 0 1
	teststaticpkg More 0 1
	teststaticpkg Double 0 1
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
	expr 1
    } else {
	testConstraint teststaticlibrary_8.x 1
	expr 0
    }]

test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    }
}

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} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticpkg_8.x} -body {
} [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 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
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 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
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 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    load [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_StaticPackage, load already-loaded package into another interp} \
test load-9.1 {Tcl_StaticLibrary, load already-loaded package into another interp} -setup {
    -constraints {teststaticpkg} \
    -setup {
	interp create child1
	interp create child2
	load {} Tcltest child1
	load {} Tcltest child2
    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 }
} -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 -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} \
    list [child1 eval { info loaded {} }] \
	[child2 eval { info loaded {} }]
} -match glob -cleanup {
    interp delete child1
    interp delete child2
} -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}}
    -cleanup { interp delete child1 ; interp delete child2 }

test load-10.1 {load from vfs} \
    -constraints [list $dll $loaded testsimplefilesystem] \
test load-10.1 {load from vfs} -setup {
    set dir [pwd]
    cd $testDir
    testsimplefilesystem 1
} -constraints [list $dll $loaded testsimplefilesystem] -body {
    -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}
    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

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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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

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
    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\000two bar] $x
    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

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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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

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 Tcltest package loaded?
    # Is the tcl::test 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-]}]
    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

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 \u00c0]" r]}
	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] \u00c0]]] 0]\n
	[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 \u20ac]" r]}
	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] \u20ac]]] 0]\n
	[encoding convertto [encoding system] €]]] 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]}
	makeFile {puts [list $argv0 $argv $tcl_interactive]} À
	catch {set f [open "|[list [interpreter] À]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
	removeFile \u00c0
	removeFile À
    } -result [list [list [encoding convertfrom [encoding system] \
	[encoding convertto [encoding system] \u00c0]]] {} 0]\n
	[encoding convertto [encoding system] À]]] {} 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]}
	makeFile {puts [list $argv0 $argv $tcl_interactive]} €
	catch {set f [open "|[list [interpreter] €]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
	removeFile \u20ac
	removeFile €
    } -result [list [list [encoding convertfrom [encoding system] \
	[encoding convertto [encoding system] \u20ac]]] {} 0]\n
	[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 \u20ac }
	puts $f "\u20ac]"
	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 "\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 "\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 Tcltest
	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 Tcltest
	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 Tcltest
	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 Tcltest
	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 Tcltest
	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

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

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

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

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

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

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

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

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 \\032
	    if 1 \{\n\032"
	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

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

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

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

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

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

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

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

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

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

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

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

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

1
2
3
4
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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

1
2
3
4
5
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.
# 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 Tcltest [info patchlevel]]
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

1
2
3
4
5
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.
# 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 Tcltest [info patchlevel]]
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

1
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.
# 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 Tcltest [info patchlevel]]
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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

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 [teststringobj set 1 1睷]
    lappend result [catch {testbooleanobj not 1} msg]
    lappend result $msg
} "1\u7777 1 {expected boolean value but got \"1\u7777\"}"
} "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

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

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

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

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

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

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

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

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

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

1
2
3
4
5
6



7
8
9
10
11
12
13
14
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.
# 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]"
    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

1
2
3
4
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
# 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 Tcltest [info patchlevel]]
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

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"}]
} -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

1
2
3
4


5
6
7
8
9
10
11
12
13
14
15
16
17
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.
# 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 Tcltest [info patchlevel]]
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\0 bar"] -1
    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

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

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

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

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

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

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

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"
    info complete "set x [testbytestring \x00]; puts hi"
} 1
test parse-15.56 {CommandComplete procedure} testbytestring {
    info complete "set x [testbytestring \0]; \{"
    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

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

1
2
3
4


5
6
7
8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24
25
26
27
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.
# 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 Tcltest [info patchlevel]]
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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
		ieeeValues(-Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
	    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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
		ieeeValues(+Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
		ieeeValues(+Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
	    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 \
	    binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Infinity)
	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
	    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 \
	    binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Normal)
	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
	    binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Infinity)
	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
	    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
    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

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]]
    expr [format {"%s" @ 0} [string repeat \xA7 25]]
} -returnCodes error -result [format {invalid character "@"
in expression "...%s" @ 0"} [string repeat \u00a7 10]]
in expression "...%s" @ 0"} [string repeat \xA7 10]]
test parseExpr-21.38 {error messages} -body {
    expr [format {0 @ "%s"} [string repeat \u00a7 25]]
    expr [format {0 @ "%s"} [string repeat \xA7 25]]
} -returnCodes error -result [format {invalid character "@"
in expression "0 @ "%s..."} [string repeat \u00a7 10]]
in expression "0 @ "%s..."} [string repeat \xA7 10]]
test parseExpr-21.39 {error messages} -body {
    expr [format {"%s" @ "%s"} [string repeat \u00a7 25] [string repeat \u00a7 25]]
    expr [format {"%s" @ "%s"} [string repeat \xA7 25] [string repeat \xA7 25]]
} -returnCodes error -result [format {invalid character "@"
in expression "...%s" @ "%s..."} [string repeat \u00a7 10] [string repeat \u00a7 10]]
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 \u00a7 25]]} m o
    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 \u00a7 25]]"} [string repeat \u00a7 10] [string repeat \u00a7 10]]
"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

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 \u0433 -1
    testexprparser г -1
} -returnCodes error -match glob -result {*invalid character*}
test parseExpr-22.20 {Bug d2ffcca163} -constraints testexprparser -body {
    testexprparser \u043f -1
    testexprparser п -1
} -returnCodes error -match glob -result {*invalid character*}
test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body {
    testexprparser in\u0433(0) -1
    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

1
2
3
4
5
6
7
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 (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 © 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 Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [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




︙


131
132
133
134
135
136
137
138

139
140
141
142
143
144
145

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

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} testbytestring {
    expr {[list \ua2] eq [testbytestring "\xc2\xa2"]}
test parseOld-7.12 {backslash substitution} {
    expr {[list \uA2] eq "¢"}
} 1
test parseOld-7.13 {backslash substitution} testbytestring {
    expr {[list \u4e21] eq [testbytestring "\xe4\xb8\xa1"]}
test parseOld-7.13 {backslash substitution} {
    expr {[list \u4E21] eq "両"}
} 1
test parseOld-7.14 {backslash substitution} testbytestring {
    expr {[list \u4e2k] eq [testbytestring "\xd3\xa2k"]}
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

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

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

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

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

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]}
    return {[expr {$num * 2}]}
}
proc pkg3::p3-2 { num } {
    return {[expr $num * 3]}
    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

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]]
    return [expr {$num * [circ3::c3-1]}]
}
proc circ2::c2-2 { num } {
    return [expr $num * [circ3::c3-2]]
    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

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
#  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}}}}"
} "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

1
2
3
4
5
6

7
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
# 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 Tcltest [info patchlevel]]
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

1
2
3
4
5
6
7
8
9



10
11
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.
# 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]
    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

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

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

1
2
3
4
5
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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 procbodytest [expr {![catch {package require procbodytest}]}]
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

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

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 procbodytest::proc command is
# 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 procbodytest -body {
test proc-4.1 {TclCreateProc, procbody obj} -constraints tcl::test -body {
    proc p x {return "$x:$x"}
    set rv [p P]
    procbodytest::proc t x 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]
    procbodytest::proc t x p
    tcl::procbodytest::proc t x p
    lappend rv [t T]
} -constraints procbodytest -cleanup {
} -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]
    procbodytest::proc t {x x1 x2} p
    tcl::procbodytest::proc t {x x1 x2} p
    lappend rv [t T]
} -constraints procbodytest -returnCodes error -cleanup {
} -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]
    procbodytest::proc t {x x1 z} p
    tcl::procbodytest::proc t {x x1 z} p
    lappend rv [t S T U]
} -constraints procbodytest -returnCodes error -cleanup {
} -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]
    procbodytest::proc t {x y z} p
    tcl::procbodytest::proc t {x y z} p
    lappend rv [t S T U]
} -constraints procbodytest -returnCodes error -cleanup {
} -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]
    procbodytest::proc t {x y {z Z}} p
    tcl::procbodytest::proc t {x y {z Z}} p
    lappend rv [t S T U]
} -returnCodes error -constraints procbodytest -cleanup {
} -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]
    procbodytest::proc t {x y {z ZZ}} p
    tcl::procbodytest::proc t {x y {z ZZ}} p
    lappend rv [t S T U]
} -constraints procbodytest -returnCodes error -cleanup {
} -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 {procbodytest memory} -body {
} -constraints {tcl::test memory} -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	procbodytest::proc tx x px
	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} procbodytest {
    procbodytest::check
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

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

1
2
3
4
5
6



7
8
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 (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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
    expr {[string length [pwd]]>0}
} 1

test pwd-1.3 {pwd takes no args} -body {
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

1
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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

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

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
    set foo "乎b q"
    regexp "乎b q" "a乎b qw幎N wq" bar
    list [string compare $foo $bar] [regexp 4 $bar]
} {0 0}
test regexp-1.8 {regexp ***= metasyntax} {
    regexp -- "***=o" "aeiou"
} 1
test regexp-1.9 {regexp ***= metasyntax} {
    set string "aeiou"




︙


190
191
192
193
194
195
196
197

198
199
200
201
202

203
204

205
206
207
208
209
210
211

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"
	"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\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"] \
	"grüß-привет"] \
	[regexp -inline -indices -start 4 {(\w+)-(\w+)} \
	"gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"]
	"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

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
    set foo "xyz555ijka乎bpqr"
    regsub a乎b xyza乎bijka乎bpqr 555 bar
    list [string compare $foo $bar] [regexp 4 $bar]
} {0 0}
test regexp-7.18 {basic regsub replacement} {
    list [regsub a+ aaa {&} foo] $foo
} {1 aaa}
test regexp-7.19 {basic regsub replacement} {
    list [regsub a+ aaa {\&} foo] $foo




︙







Changes to tests/regexpComp.test.



1
2
3
4
5
6
7
8
9



10
11
12
13
14
15
16

1
2
3
4
5
6



7
8
9
10
11
12
13
14
15
16







-
-
-
+
+
+








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

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
	set foo "乎b q"
	regexp "乎b q" "a乎b qw幎N wq" bar
	list [string compare $foo $bar] [regexp 4 $bar]
    }
} {0 0}

test regexpComp-1.8 {regexp ***= metasyntax} {
    evalInProc {
	regexp -- "***=o" "aeiou"




︙


443
444
445
446
447
448
449
450
451


452
453
454
455
456
457
458

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
	set foo "xyz555ijka乎bpqr"
	regsub a乎b xyza乎bijka乎bpqr 555 bar
	list [string compare $foo $bar] [regexp 4 $bar]
    }
} {0 0}

test regexpComp-8.1 {case conversion in regsub} {
    evalInProc {
	list [regsub -nocase a(a+) xaAAaAAay & foo] $foo




︙







Changes to tests/registry.test.



1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27

28
29
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44

1
2
3
4
5
6
7
8
9


10
11
12
13
14
15
16
17
18
19
20
21

22
23
24
25
26

27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
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.
# 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.5]
	    set ::regver [package require registry 1.3.6]
	}]} {
	testConstraint reg 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
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.5}
} {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

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

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]]
	    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 < [expr $argc - 1]} {
		set serverAddress [lindex $argv [expr $i + 1]]
	    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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

1
2
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]>
# 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 Tcltest [info patchlevel]]
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

1
2
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.
# 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 Tcltest [info patchlevel]]
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

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

1
2
3
4
5
6
7
8
9


10
11
12
13
14
15

16
17
18
19




20
21
22
23
24



25
26
27
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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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.

package require Tcl 8.5-

apply [list {} {
    global auto_path
    global tcl_library
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
    if {"::tcltest" ni [namespace children]} {
        package require tcltest 2.5
        namespace import -force ::tcltest::*
    }

foreach i [interp children] {
    interp delete $i
}
    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 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 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
    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
}
    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}
    # 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.

    # 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}
    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} -- {}}
    # 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]]
    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 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]
        # 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]]
        # 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]
        # 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]]
        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}
        # 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.
        # 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]]
        # 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]
        # 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]]
        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}}
        # 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]]
        # 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]
        # 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]]
        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}}
        # 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]]
        # 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]
        # 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]]
        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}}
        # 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]
        # 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]
        # 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]
        # 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]]
        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]]
        # 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}]
        # 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]]
        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]]
        # 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]]
        # 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}}
        # 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}]
        # 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]]
        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]]
        # 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]]
        # 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}]
        # 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]]
        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]]
        # 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}}
        # 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]]
        # 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}}
        # 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}]
        # 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]]
        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]]
        # 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}}
        # 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]]
        # 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}]
        # 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
        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

10
11
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 (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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

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 - Tcltest - but it might be absent if we're in standard tclsh)
# package - tcl::test - but it might be absent if we're in standard tclsh)

testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
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

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

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 {teststaticpkg Safepkg1 0 0}
test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
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 {} Safepkg1}
    interp eval $i {load {} Safepfx1}
} -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 {
} -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 {} Safepkg1}} m o
    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 binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure
    invoked from within
"load {} Safepkg1"
"load {} Safepfx1"
    invoked from within
"interp eval $i {load {} Safepkg1}"}
test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body {
"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 {} Safepkg1}
    interp eval $i {load {} Safepfx1}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied (static package)}
} -result {permission denied (static library)}
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}
} -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 TcltestPackage -body {
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 {} Safepkg1 x}
    interp eval $i {interp create x; load {} Safepfx1 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 {
} -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 {} Safepkg1 x}} m o
    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 binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure
    invoked from within
"load {} Safepkg1 x"
"load {} Safepfx1 x"
    invoked from within
"interp eval $i {interp create x; load {} Safepkg1 x}"}
"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

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

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

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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
		ieeeValues(-Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
	    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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
		ieeeValues(+Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
		ieeeValues(+Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
	    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 \
	    binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Infinity)
	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
	    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 \
	    binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Normal)
	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
	    binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Infinity)
	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
	    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

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"
    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\u00c7cdef" "ab%c%c" a b] $a $b
    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"
    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

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

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

1
2
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.
# 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 Tcltest [info patchlevel]]
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

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

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 Tcltest [info patchlevel]]
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 {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} {
if {[info exists ::env(MAC_CI)]} {
    return
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
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(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
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

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

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] -result {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] -result {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}
    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

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 1 "== test \[$::localhost\]:$port $testmode =="
    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

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 1 "** trma / $::count ** $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

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 1 "** iter / $::count **"
      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 1 "== stop / $::count =="
    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

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 knownMsvcBug} \
    -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

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

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

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]
    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\32c" source.file]
    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) \u221A; set x correct"
    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 (\u001A) as a cross-platform
    # 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 \u001A in
    # 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) \u221A; set x correct"
    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

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}"
    puts $f "proc € {} {return foo}"
    close $f
} -body {
    source $sourcefile
    \u20ac
    €
} -cleanup {
    removeFile source.file
    rename \u20ac {}
    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 \u20ac {} {return foo}"
    puts $f "proc € {} {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




︙







Changes to tests/split.test.



1
2
3
4
5
6
7
8
9



10
11
12
13
14
15
16

1
2
3
4
5
6



7
8
9
10
11
12
13
14
15
16







-
-
-
+
+
+








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

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 x ab\x00c
        set y [split $x {}]
        return $y
    }
    foo
} "a b \000 c"
} "a b \x00 c"
test split-1.10 {basic split commands} {
    split "a0ab1b2bbb3\000c4" ab\000c
    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 "\u0001ab\u0001cd\u0001\u0001ef\u0001" \1
    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\U1F4A9b" {}
} -result "a \U1F4A9 b"
    split "a💩b" {}
} -result "a 💩 b"
test split-1.16 {basic split commands} -body {
    split "a\U1F4A9b" \U1F4A9
    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

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

1
2
3
4
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.
# 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 Tcltest [info patchlevel]]
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

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}
    run {string compare ab牦 ab牧}
} -1
test string-2.11.1.$noComp {string compare, unicode} {
    run {string compare \334 \xDC}
    run {string compare Ü Ü}
} 0
test string-2.11.2.$noComp {string compare, unicode} {
    run {string compare \334 \xFC}
    run {string compare Ü ü}
} -1
test string-2.11.3.$noComp {string compare, unicode} {
    run {string compare \334\334\334\374\374 \334\334\334\334\334}
    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

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}
    run {string compare -nocase Ü Ü}
} 0
test string-2.15.2.$noComp {string compare -nocase} {
    run {string compare -nocase \334\334\334\374\xFC \334\334\334\334\334}
    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 \334\334\334 \334\334\374}
    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

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

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}
    run {string equal ab牦 ab牧}
} 0
test string-3.17.$noComp {string equal, unicode} {
    run {string equal \334 \xDC}
    run {string equal Ü Ü}
} 1
test string-3.18.$noComp {string equal, unicode} {
    run {string equal \334 \xFC}
    run {string equal Ü ü}
} 0
test string-3.19.$noComp {string equal, unicode} {
    run {string equal \334\334\334\374\374 \334\334\334\334\334}
    run {string equal ÜÜÜüü ÜÜÜÜÜ}
} 0
test string-3.20.$noComp {string equal, high bit} {
    # This test will fail if the underlying comparaison
    # 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 \334 \xDC}
    run {string equal -nocase Ü Ü}
} 1
test string-3.23.$noComp {string equal, -nocase unicode} {
    run {string equal -nocase \334\334\334\374\xFC \334\334\334\334\334}
    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 \334\334\334 \334\334\374}
    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

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}
    run {string first x abc牦x}
} 4
test string-4.10.$noComp {string first, unicode} {
    run {string first \u7266 abc\u7266x}
    run {string first 牦 abc牦x}
} 3
test string-4.11.$noComp {string first, start index} {
    run {string first \u7266 abc\u7266x 3}
    run {string first 牦 abc牦x 3}
} 3
test string-4.12.$noComp {string first, start index} -body {
    run {string first \u7266 abc\u7266x 4}
    run {string first 牦 abc牦x 4}
} -result -1
test string-4.13.$noComp {string first, start index} -body {
    run {string first \u7266 abc\u7266x end-2}
    run {string first 牦 abc牦x end-2}
} -result 3
test string-4.14.$noComp {string first, negative start index} -body {
    run {string first b abc -1}
} -result 1
test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} -body {
    # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
    # strings was incorrect, leading to an index returned by [string first]
    # which pointed past the end of the string.
    set uchar \u057E    ;# character with two-byte encoding in utf-8
    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

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}
    run {string index abc牦d 4}
} d
test string-5.11.$noComp {string index, unicode} {
    run {string index abc\u7266d 3}
} \u7266
    run {string index abc牦d 3}
} 牦
test string-5.12.$noComp {string index, unicode over char length, under byte length} -body {
    run {string index \334\374\334\374 6}
    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

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 {}]


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




︙


556
557
558
559
560
561
562
563

564
565
566
567
568
569
570
571

572
573
574
575
576
577
578

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\xFC}" 1
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\374}
    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

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\xDC567}] $var
    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)]}
    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

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 [largest_int]0}] $var
    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

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)]}
    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}
    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
    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}
    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\xDCUE}] $var
    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

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\xDCUE}
    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\xFCue}] $var
    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\xFCab\xDCAB\u5001\U1D7CA}
    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

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

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

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}

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}
    run {string las x xxxx12牦xx345x678}
} 12
test string-7.8.$noComp {string last, unicode} {
    run {string las \u7266 xxxx12\u7266xx345x678}
    run {string las 牦 xxxx12牦xx345x678}
} 6
test string-7.9.$noComp {string last, stop index} {
    run {string las \u7266 xxxx12\u7266xx345x678}
    run {string las 牦 xxxx12牦xx345x678}
} 6
test string-7.10.$noComp {string last, unicode} {
    run {string las \u7266 xxxx12\u7266xx345x678}
    run {string las 牦 xxxx12牦xx345x678}
} 6
test string-7.11.$noComp {string last, start index} {
    run {string last \u7266 abc\u7266x 3}
    run {string last 牦 abc牦x 3}
} 3
test string-7.12.$noComp {string last, start index} {
    run {string last \u7266 abc\u7266x 2}
    run {string last 牦 abc牦x 2}
} -1
test string-7.13.$noComp {string last, start index} {
    ## Constrain to last 'a' should work
    run {string last ba badbad end-1}
} 3
test string-7.14.$noComp {string last, start index} {
    ## Constrain to last 'b' should skip last 'ba'
    run {string last ba badbad end-2}
} 0
test string-7.15.$noComp {string last, start index} {
    run {string last \334a \334ad\334ad 0}
    run {string last Üa ÜadÜad 0}
} -1
test string-7.16.$noComp {string last, start index} {
    run {string last \334a \334ad\334ad end-1}
    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

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\u7266"}
    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

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 \374 ue UE \334] "a\374ueUE\000EU"}
} aueue\334\0EU
    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 \374 ue UE \334] "a\374ueUE\000EU"}
} aue\334\334\0EU
    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

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\334 A\374}
    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

1453
1454
1455
1456
1457
1458
1459

1460
1461
1462


1463
1464
1465
1466
1467
1468
1469
1470
1471








-
+


-
-
+
+








test string-12.15.$noComp {string range} {
    run {string range abcdefghijklmnop end 1000}
} {p}
test string-12.16.$noComp {string range} {
    run {string range abcdefghijklmnop end end-1}
} {}
test string-12.17.$noComp {string range, unicode} {
    run {string range ab\u7266cdefghijklmnop 5 5}
    run {string range ab牦cdefghijklmnop 5 5}
} e
test string-12.18.$noComp {string range, unicode} {
    run {string range ab\u7266cdefghijklmnop 2 3}
} \u7266c
    run {string range ab牦cdefghijklmnop 2 3}
} 牦c
test string-12.19.$noComp {string range, bytearray object} {
    set b [binary format I* {0x50515253 0x52}]
    set r1 [run {string range $b 1 end-1}]
    set r2 [run {string range $b 1 6}]
    run {string equal $r1 $r2}
} 1
test string-12.20.$noComp {string range, out of bounds indices} {




︙


1551
1552
1553
1554
1555
1556
1557
1558
1559


1560
1561
1562
1563
1564
1565
1566


1567
1568
1569
1570
1571
1572
1573

1540
1541
1542
1543
1544
1545
1546


1547
1548
1549
1550
1551
1552
1553


1554
1555
1556
1557
1558
1559
1560
1561
1562








-
-
+
+





-
-
+
+








test string-13.10.$noComp {string repeat} {
    run {string repeat def 0}
} {}
test string-13.11.$noComp {string repeat} {
    run {string repeat def 1}
} def
test string-13.12.$noComp {string repeat} {
    run {string repeat ab\u7266cd 3}
} ab\u7266cdab\u7266cdab\u7266cd
    run {string repeat ab牦cd 3}
} ab牦cdab牦cdab牦cd
test string-13.13.$noComp {string repeat} {
    run {string repeat \x00 3}
} \x00\x00\x00
test string-13.14.$noComp {string repeat} {
    # The string range will ensure us that string repeat gets a unicode string
    run {string repeat [run {string range ab\u7266cd 2 3}] 3}
} \u7266c\u7266c\u7266c
    run {string repeat [run {string range ab牦cd 2 3}] 3}
} 牦c牦c牦c

test string-14.1.$noComp {string replace} {
    list [catch {run {string replace}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
test string-14.2.$noComp {string replace} {
    list [catch {run {string replace a 1}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}




︙


1621
1622
1623
1624
1625
1626
1627












1628
1629
1630
1631
1632
1633
1634

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

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 \u0000}]]
    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

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

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

1
2
3
4
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.
# 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 Tcltest [info patchlevel]]
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

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\u00ef\u00bf\u00aeghi
    set x abc\xEF\xBF\xAEghi
    string length $x
    set y $x
    list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \
    list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string"
} "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\u00ef\u00bf\u00aeghi
    set x abc\xEF\xBF\xAEghi
    set y $x
    string length $x
    list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \
    list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string"
} "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\u00ef\u00bf\u00aeghi
    set x abc\xEF\xBF\xAEghi
    testdstring free
    testdstring append \u00ae\u00bf\u00ef -1
    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\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none"
} "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\u00ef\u00bf\u00aeghi
    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\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi string\
abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi\
} "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 \u00ae\u00bf\u00ef -1
    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\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none"
} "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\u00ef\u00bf\u00aeghi
    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\u00ef\u00bf\u00aeghijkl jkl string none"
} "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\u00ef\u00bf\u00aeghi
    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\u00ef\u00bf\u00aeghi9 9 string int"
} "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\u00fcb\u00e5c\u00ef
    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 \u00fc b \u00e5 c \u00ef"
} "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} {
    # 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
    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\u00EF\u00EFde" string string]
} [list none "bcïïde" string string]
test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj {
    # set x "abcïïdef"
    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]
} [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 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				\
} [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

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 "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" 0
} "\u00ef"
    string index "\xEFa\xBFb\xAEc\xAE\xBFd\xEF" 0
} "\xEF"
test stringObj-12.5 {Tcl_GetUniChar} testobj {
    set x "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef"
    set x "\xEFa\xBFb\xAEc\xAE\xBFd\xEF"
    list [string index $x 4] [string index $x 0]
} "\u00ae \u00ef"
} "\xAE \xEF"
test stringObj-12.6 {Tcl_GetUniChar} testobj {
    string index "\u00efa\u00bfb\u00aec\u00ef\u00bfd\u00ae" end
} "\u00ae"
    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 "\u00ae"
    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 "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE"
    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 "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
    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

1
2
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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

1
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.
# 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 Tcltest [info patchlevel]]
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

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

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

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

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

1
2
3
4
5
6



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.
# 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 Tcltest [info patchlevel]]
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

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

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 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\0cd
    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\0cd
    after cancel "set x ab\0ef"
    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\0cd
    after cancel set x ab\0ef
    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\0cd"
    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\0cd
    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\0cd]
    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

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

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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

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

1
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.
# 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 Tcltest [info patchlevel]]
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

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 attributes td1/td2 -permissions 0
    file rename td1/td2/td3 td2
} -returnCodes error -cleanup {
    file attributes td1/td2 -permissions 0755
    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

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 attr foo -perm 0o40555
    file rename foo/bar /tmp
} -returnCodes error -cleanup {
    catch {file delete /tmp/bar}
    catch {file attr foo -perm 040777}
    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

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] \
    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 0000
    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

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
    file attributes $nd -permissions 0
    pwd
} -returnCodes error -cleanup {
    cd $cd
    file attributes $nd -permissions 0755
    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

1
2
3
4
5
6

7
8
9
10
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.
# Copyright © 1998-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 Tcltest [info patchlevel]]
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 0777
    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

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

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

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

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"
    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 "\xa7"
} -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

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.
# 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

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.
# 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

1
2
3
4
5
6



7
8
9
10
11
12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
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 (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2003-2004 by Georgios Petasis
# 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 Tcltest [info patchlevel]]
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 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?"}
} -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 ?packageName? ?interp?"}
} -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 package name}
} -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 package name}
} -result {must specify either file name or prefix}
test unload-1.6 {basic errors} -returnCodes error -body {
    unload {} Unknown
} -result {package "Unknown" is loaded statically and cannot be unloaded}
} -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 package name} [list $dll $loaded] {
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 package name} [list $dll $loaded] {
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 package name} -setup {
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 package name} -setup {
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 package name} -setup {
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 package name} -setup {
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, with package name conversion} \
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
    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} \
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] \
	    [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 {
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
	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 {
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
	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 {
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 package name conversion} -setup {
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] \
	    [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 {
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, with package name conversion} -setup {
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] \
	    [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 {
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] \
	    [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 {
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 package name} -setup {
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 package name} -setup {
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
	 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

1
2
3
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.
# 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]
    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

1
2
3
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.
# 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 Tcltest [info patchlevel]]
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

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

1
2
3
4


5
6
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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 Tcltest [info patchlevel]]
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 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]]




︙


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

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 {"\u4E4E" eq [testbytestring \xE4\xB9\x8E]}
    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 Uesc testbytestring} {
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} {ucs2 Uesc testbytestring} {
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 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc testbytestring} {
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

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} {testbytestring ucs2_utf16} {
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} {testbytestring ucs4} {
    string length [testbytestring \xF0\x90\x80\x80]
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} {testbytestring ucs2} {
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} {Uesc ucs4} {
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

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 A[testbytestring \xA0]
    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 {Tcl_UtfNext} {testutfnext testbytestring} {
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

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]
} -1
    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_utf16} {
test utf-6.30.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2]
} 1
test utf-6.30.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    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_utf16} {
test utf-6.32.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0]
} 1
test utf-6.32.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    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

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 \u8820
    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

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 \u8820G
    testutfnext 蠠G
} 3
test utf-6.63 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xA0]
    testutfnext [testbytestring \xE8\xA0\xA0\xA0]
} 3
test utf-6.64 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xD0]
    testutfnext 蠠[testbytestring \xD0]
} 3
test utf-6.65 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xE8]
    testutfnext 蠠[testbytestring \xE8]
} 3
test utf-6.66 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xF2]
    testutfnext 蠠[testbytestring \xF2]
} 3
test utf-6.67 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xF8]
    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_utf16} {
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 ucs4} {
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_utf16} {
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 ucs4} {
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_utf16} {
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 ucs4} {
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_utf16} {
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 ucs4} {
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_utf16} {
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 ucs4} {
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_utf16} {
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 ucs4} {
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_utf16} {
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 ucs4} {
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

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_utf16} {
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 ucs4} {
test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF0\x90\x80\x80]
} 4
test utf-6.88 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring} {
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 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring} {
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_utf16} {
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 ucs4} {
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 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring} {
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 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring} {
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 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {
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 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {
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

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\u8820[testbytestring \xA0] 2
    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 A[testbytestring \xA0]
    testutfprev [testbytestring A\xA0]
} 1
test utf-7.8.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 2
    testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 2
} 1
test utf-7.8.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xF8\xA0\xA0] 2
    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

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\u8820[testbytestring \xA0] 3
    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 A[testbytestring \xA0\xA0]
    testutfprev [testbytestring A\xA0\xA0]
} 2
test utf-7.13.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 3
    testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 3
} 2
test utf-7.13.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xA0\xF8\xA0] 3
    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

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\u8820
    testutfprev A蠠
} 1
test utf-7.16.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A\u8820[testbytestring \xA0] 4
    testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 4
} 1
test utf-7.16.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A\u8820[testbytestring \xF8] 4
    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 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} {
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]
} 2
test utf-7.23 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0]
} 2
} 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

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 utf16} {
test utf-7.29 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF0\x80\x80\x80]
} 2
} 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

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 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring utf16} {
test utf-7.39.0 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring ucs2} {
    testutfprev A[testbytestring \xF0\x90\x80\x80]
} 2
} 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

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 utf16} {
test utf-7.46 {Tcl_UtfPrev -- no lead byte at start}  {testutfprev testbytestring} {
    testutfprev [testbytestring \xA0\xA0\xA0\xA0]
} 1
} 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 \u8820 2
    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 utf16} {
test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF]
} 2
test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
} 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.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
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.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
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.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
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.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
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 utf16} {
test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF4\x90\x80\x80]
} 2
} 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 \u4E4E\u25A 0
} \u4E4E
    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 \u4E4E\u25A\xFF\u543 2
} \xFF
    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 \uD83D\uDE00G 0
} \U1F600
    string index 😀G 0
} 😀
test utf-8.7.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \uD83D\uDE00G 0
} \U1F600
    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 \uD83D\uDE00G 1
    string index 😀G 1
} G
test utf-8.8.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \uD83D\uDE00G 1
    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 \uD83D\uDE00G 2
    string index 😀G 2
} {}
test utf-8.9.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \uD83D\uDE00G 2
    string index 😀G 2
} G
test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
    string index \U1F600G 0
test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
    string index 😀G 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
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} {Uesc ucs4} {
    string index \U1F600G 1
test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
    string index 😀G 1
} G
test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
    string index \U1F600G 1
test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index 😀G 1
} {}
test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
    string index \U1F600G 2
test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
    string index 😀G 2
} {}
test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
    string index \U1F600G 2
test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
    string index 😀G 2
} {}
test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
    string index \U1F600G 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 \u4E4E\u25A\xFF\u543klmnop 1 5
} \u25A\xFF\u543kl
    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 \uD83D\uDE00G 0 0
} \U1F600
    string range 😀G 0 0
} 😀
test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
    string range \uD83D\uDE00G 0 0
} \U1F600
    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 \U1F600G 1 1
    string range 😀G 1 1
} G
test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
    string range \uD83D\uDE00G 1 1
    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 \uD83D\uDE00G 2 2
    string range 😀G 2 2
} {}
test utf-9.5.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
    string range \uD83D\uDE00G 2 2
    string range 😀G 2 2
} G
test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs2} {
    string range \U1f600G 0 0
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} {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
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} {Uesc ucs4} {
    string range \U1f600G 1 1
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} {Uesc utf16} {
    string range \U1f600G 1 1
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} {Uesc ucs2} {
    string range \U1f600G 2 2
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} {Uesc ucs4} {
    string range \U1f600G 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} {Uesc utf16} {
    string range \U1f600G 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} {Uesc fullutf testbytestring} {
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} {Uesc fullutf testbytestring} {
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

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		{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}
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 \u01E3gh
} \u01E2GH
    string toupper ǣgh
} ǢGH
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
    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 \uD801\uDC28
} \uD801\uDC00
    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 \xC3GH
} \xE3gh
    string tolower ÃGH
} ãgh
test utf-12.4 {Tcl_UtfToLower} {
    string tolower \u01E2GH
} \u01E3gh
    string tolower ǢGH
} ǣgh
test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
    string tolower \u10D0\u1C90
} \u10D0\u10D0
    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} {Uesc fullutf} {
    string tolower \U10400
} \U10428
test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} fullutf {
    string tolower 𐐀
} 𐐨
test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} fullutf {
    string tolower \uD801\uDC00
} \uD801\uDC28
    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 \xE3GH
} \xC3gh
    string totitle ãGH
} Ãgh
test utf-13.4 {Tcl_UtfToTitle} {
    string totitle \u01F3AB
} \u01F2ab
    string totitle dzAB
} Dzab
test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
    string totitle \u10D0\u1C90
} \u10D0\u1C90
    string totitle აᲐ
} აᲐ
test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
    string totitle \u1C90\u10D0
} \u1C90\u10D0
    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} {Uesc fullutf} {
    string totitle \U10428\U10400
} \U10400\U10428
test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
    string totitle 𐐨𐐀
} 𐐀𐐨
test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
    string totitle \uD801\uDC28\uD801\uDC00
} \uD801\uDC00\uD801\uDC28
    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 \u0178\xFF
} \u0178\u0178
    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 \u0178\xFF\uA78D\u01C5
} \xFF\xFF\u0265\u01C6
    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 \u01C4
} \u01C5
    string totitle DŽ
} Dž
test utf-18.2 {Tcl_UniCharToTitle, subtract one for title} {
    string totitle \u01C6
} \u01C5
    string totitle dž
} Dž
test utf-18.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} {
    string totitle \u017F
} \x53
    string totitle ſ
} S
test utf-18.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} {
    string totitle \xFF
} \u0178
    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} knownBug {
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 \u1040\u021F\u0220
    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:]]+$} \u1040\u021F\u0220] [regexp {^\w+$} \u1040\u021F\u0220_\u203F\u2040\u2054\uFE33\uFE34\uFE4D\uFE4E\uFE4F\uFF3F]
    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:]]+$} \uFBC1
    regexp {^[[:print:]]+$} ﯁
} 1
test utf-21.4 {TclUniCharIsGraph} {
    # [Bug 3464428]
    string is graph \u0120
    string is graph Ġ
} 1
test utf-21.5 {unicode graph char in regc_locale.c} {
    # [Bug 3464428]
    regexp {^[[:graph:]]+$} \u0120
    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

1289
1290
1291
1292
1293
1294
1295

1296
1297
1298
1299
1300

1301
1302
1303
1304

1305
1306
1307
1308
1309

1310
1311
1312
1313

1314
1315
1316
1317
1318
1319
1320
1321








-
+




-
+



-
+




-
+



-
+








    regexp {^[[:cntrl:]]*$} \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF
} 1

test utf-22.1 {TclUniCharIsWordChar} {
    string wordend "xyz123_bar fg" 0
} 10
test utf-22.2 {TclUniCharIsWordChar} {
    string wordend "x\u5080z123_bar\u203C fg" 0
    string wordend "x傀z123_bar‼ fg" 0
} 10

test utf-23.1 {TclUniCharIsAlpha} {
    # this returns 1 with Unicode 7 compliance
    string is alpha \u021F\u0220\u037F\u052F
    string is alpha ȟȠͿԯ
} 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
    regexp {^[[:alpha:]]+$} ȟȠͿԯ
} 1

test utf-24.1 {TclUniCharIsDigit} {
    # this returns 1 with Unicode 7 compliance
    string is digit \u1040\uABF0
    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:]]+$} \u1040\uABF0] [regexp {^\d+$} \u1040\uABF0]
    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

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		{Uesc ucs4}
UniCharCaseCmpTest < \uFFFF \U10000		ucs4
UniCharCaseCmpTest > [format %c 0x10000] \uFFFF	ucs4
UniCharCaseCmpTest > \U10000 \uFFFF		{Uesc 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

1
2
3


4
5
6
7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
25
26
27
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.
# 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 Tcltest [info patchlevel]]
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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
		ieeeValues(-Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
	    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 \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
		ieeeValues(+Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
		ieeeValues(+Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
		ieeeValues(NaN)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \
	    binary scan \x00\x00\x00\x00\x00\x00\xF8\xFF d \
		ieeeValues(-NaN)
	    binary scan \xef\xcd\xab\x89\x67\x45\xfb\xff d \
	    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 \
	    binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Infinity)
	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
	    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 \
	    binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Normal)
	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
	    binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Infinity)
	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
	    binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(NaN)
	    binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \
	    binary scan \xFF\xF8\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-NaN)
	    binary scan \xff\xfb\x45\x67\x89\xab\xcd\xef d \
	    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

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]
	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

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
    # 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

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 \u4e4fu
    Wrapper_Tcl_StringMatch *u 乏u
} 1
test util-5.8 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch a?c abc
} 1
test util-5.9 {Tcl_StringMatch: UTF-8} {
    # skip one character in string
    Wrapper_Tcl_StringMatch a?c a\u4e4fc
    Wrapper_Tcl_StringMatch a?c a乏c
} 1
test util-5.10 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch a??c abc
} 0
test util-5.11 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch ?1??4???8? 0123456789
} 1
test util-5.12 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch {[abc]bc} abc
} 1
test util-5.13 {Tcl_StringMatch: UTF-8} {
    # string += Tcl_UtfToUniChar(string, &ch);
    Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc"
    Wrapper_Tcl_StringMatch "\[乏xy\]bc" "乏bc"
} 1
test util-5.14 {Tcl_StringMatch} {
    # if ((*pattern == ']') || (*pattern == '\0'))
    # if ((*pattern == ']') || (*pattern == '\x00'))
    # badly formed pattern
    Wrapper_Tcl_StringMatch {[]} {[]}
} 0
test util-5.15 {Tcl_StringMatch} {
    # if ((*pattern == ']') || (*pattern == '\0'))
    # if ((*pattern == ']') || (*pattern == '\x00'))
    # badly formed pattern
    Wrapper_Tcl_StringMatch {[} {[}
} 0
test util-5.16 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch {a[abc]c} abc
} 1
test util-5.17 {Tcl_StringMatch: UTF-8} {
    # pattern += Tcl_UtfToUniChar(pattern, &endChar);
    # get 1 UTF-8 character
    Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc"
    Wrapper_Tcl_StringMatch "a\[a乏c]c" "a乏c"
} 1
test util-5.18 {Tcl_StringMatch: UTF-8} testbytestring {
    # pattern += Tcl_UtfToUniChar(pattern, &endChar);
    # proper advance: wrong answer would match on UTF trail byte of \u4e4f
    Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [testbytestring a\x8Fc]
    # proper advance: wrong answer would match on UTF trail byte of 乏
    Wrapper_Tcl_StringMatch {a[a乏c]c} [testbytestring a\x8Fc]
} 0
test util-5.19 {Tcl_StringMatch: UTF-8} {
    # pattern += Tcl_UtfToUniChar(pattern, &endChar);
    # proper advance.
    Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc"
    Wrapper_Tcl_StringMatch {a[a乏c]c} "acc"
} 1
test util-5.20 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch {a[xyz]c} abc
} 0
test util-5.21 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch {12[2-7]45} 12345
} 1
test util-5.22 {Tcl_StringMatch: UTF-8 range} {
    Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "0"
    Wrapper_Tcl_StringMatch "\[一-乏]" "0"
} 0
test util-5.23 {Tcl_StringMatch: UTF-8 range} {
    Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\u4e33"
    Wrapper_Tcl_StringMatch "\[一-乏]" "丳"
} 1
test util-5.24 {Tcl_StringMatch: UTF-8 range} {
    Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\uff08"
    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

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} \ue1x
    Wrapper_Tcl_StringMatch {[A-]]x} \xE1x
} 0
test util-5.43 {Tcl_StringMatch: skip correct number of ']'} {
    Wrapper_Tcl_StringMatch \[A-]\ue1]x \ue1x
    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 == '\0')
    # 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

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\u0000 a\x80
    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]
    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]
    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
    interp create 吠
    interp create [list 吠 foo]
    interp alias {} fooset [list 吠 foo] set
    set result [interp target {} fooset]
    interp delete \u5420
    interp delete 吠
    set result
} "\u5420 foo"
} "吠 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 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 \u00A0 -1
    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

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} {
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} {
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} {
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} {
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} {
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

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
    expr {1.1e-5}
} {1.1e-5}
test util-11.2 {Tcl_PrintDouble - scaling} {
    expr 1.1e-4
    expr {1.1e-4}
} {0.00011}
test util-11.3 {Tcl_PrintDouble - scaling} {
    expr 1.1e-3
    expr {1.1e-3}
} {0.0011}
test util-11.4 {Tcl_PrintDouble - scaling} {
    expr 1.1e-2
    expr {1.1e-2}
} {0.011}
test util-11.5 {Tcl_PrintDouble - scaling} {
    expr 1.1e-1
    expr {1.1e-1}
} {0.11}
test util-11.6 {Tcl_PrintDouble - scaling} {
    expr 1.1e0
    expr {1.1e0}
} {1.1}
test util-11.7 {Tcl_PrintDouble - scaling} {
    expr 1.1e1
    expr {1.1e1}
} {11.0}
test util-11.8 {Tcl_PrintDouble - scaling} {
    expr 1.1e2
    expr {1.1e2}
} {110.0}
test util-11.9 {Tcl_PrintDouble - scaling} {
    expr 1.1e3
    expr {1.1e3}
} {1100.0}
test util-11.10 {Tcl_PrintDouble - scaling} {
    expr 1.1e4
    expr {1.1e4}
} {11000.0}
test util-11.11 {Tcl_PrintDouble - scaling} {
    expr 1.1e5
    expr {1.1e5}
} {110000.0}
test util-11.12 {Tcl_PrintDouble - scaling} {
    expr 1.1e6
    expr {1.1e6}
} {1100000.0}
test util-11.13 {Tcl_PrintDouble - scaling} {
    expr 1.1e7
    expr {1.1e7}
} {11000000.0}
test util-11.14 {Tcl_PrintDouble - scaling} {
    expr 1.1e8
    expr {1.1e8}
} {110000000.0}
test util-11.15 {Tcl_PrintDouble - scaling} {
    expr 1.1e9
    expr {1.1e9}
} {1100000000.0}
test util-11.16 {Tcl_PrintDouble - scaling} {
    expr 1.1e10
    expr {1.1e10}
} {11000000000.0}
test util-11.17 {Tcl_PrintDouble - scaling} {
    expr 1.1e11
    expr {1.1e11}
} {110000000000.0}
test util-11.18 {Tcl_PrintDouble - scaling} {
    expr 1.1e12
    expr {1.1e12}
} {1100000000000.0}
test util-11.19 {Tcl_PrintDouble - scaling} {
    expr 1.1e13
    expr {1.1e13}
} {11000000000000.0}
test util-11.20 {Tcl_PrintDouble - scaling} {
    expr 1.1e14
    expr {1.1e14}
} {110000000000000.0}
test util-11.21 {Tcl_PrintDouble - scaling} {
    expr 1.1e15
    expr {1.1e15}
} {1100000000000000.0}
test util-11.22 {Tcl_PrintDouble - scaling} {
    expr 1.1e16
    expr {1.1e16}
} {11000000000000000.0}
test util-11.23 {Tcl_PrintDouble - scaling} {
    expr 1.1e17
    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

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
	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
	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]
    testprint %lld [expr {2**63-1}]
} {9223372036854775807}

test util-18.2 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr 2**63-1]
    testprint %I64d [expr {2**63-1}]
} {9223372036854775807}

test util-18.3 {Tcl_ObjPrintf} {testprint} {
    testprint %qd [expr 2**63-1]
    testprint %qd [expr {2**63-1}]
} {9223372036854775807}

test util-18.4 {Tcl_ObjPrintf} {testprint} {
    testprint %jd [expr 2**63-1]
    testprint %jd [expr {2**63-1}]
} {9223372036854775807}

test util-18.5 {Tcl_ObjPrintf} {testprint} {
    testprint %lld [expr -2**63]
    testprint %lld [expr {-2**63}]
} {-9223372036854775808}

test util-18.6 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr -2**63]
    testprint %I64d [expr {-2**63}]
} {-9223372036854775808}

test util-18.7 {Tcl_ObjPrintf} {testprint} {
    testprint %qd [expr -2**63]
    testprint %qd [expr {-2**63}]
} {-9223372036854775808}

test util-18.8 {Tcl_ObjPrintf} {testprint} {
    testprint %jd [expr -2**63]
    testprint %jd [expr {-2**63}]
} {-9223372036854775808}

test util-18.9 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %I32d" [expr -2**63+2]
    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

1
2
3
4
5
6
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.
# 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 Tcltest [info patchlevel]]
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

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}
    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 \u20ac \xe4] {info vars}] 1 2] \
	[apply [list [list [list \u20ac \u20ac] [list \xe4 \xe4]] {info vars}]] \
	[apply [list [list € ä] {info vars}] 1 2] \
	[apply [list [list [list € €] [list ä ä]] {info vars}]] \
} -cleanup {
    rename p {}
} -result [lrepeat 3 [list \u20ac \xe4]]
} -result [lrepeat 3 [list € ä]]
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]}
    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 \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]}]] \
	[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\u20ac v\xe4]]
} -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

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}]
         [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

1
2
3
4
5
6
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.
# 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]}
    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

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}
	if {$index == 2} {set index [expr {$index + 1}]; continue}
	set result [concat $result [lindex $list $index]]
	set index [expr $index+1]
	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 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

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.
# 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

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
	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

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==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

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}]
    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

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==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

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==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==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

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
	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

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==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

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}]
    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

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==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==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

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==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

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.
# 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

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21


22
23
24
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.
# 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.3]
	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
	    set ::ddever [package require dde 1.4.4]
	    set ::ddelib [info loaded {} Dde]}]} {
	testConstraint dde 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
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 [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

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}
} {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
    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
    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
    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

1
2
3
4
5
6


7
8
9
10
11
12
13
14
15
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.
# 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 Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [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
# Some things fail under all Continuous Integration systems for subtle reasons
# such as CI often running with elevated privileges in a container.
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)]}]
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

53
54
55
56
57
58
59








60
61
62
63
64
65
66








-
-
-
-
-
-
-
-








	}
	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 *] {




︙


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

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 notWine} -body {
} -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 notWine} -body {
} -constraints {win testfile notInCIenv} -body {
    testfile mv / td1
} -returnCodes error -result EINVAL
test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
} -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 notWine} -body {
} -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

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.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 {




︙


228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259

260
261
262
263
264
265
266

215
216
217
218
219
220
221





222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240

241
242
243
244
245
246
247
248








-
-
-
-
-



















-
+








    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 {
} -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

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 notWine} -body {
} -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 notWine} -body {
} -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 notWine} -body {
} -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

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 notWine} -body {
} -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

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 notWine} -body {
} -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

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.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 {




︙


636
637
638
639
640
641
642
643

644
645
646
647
648
649
650

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 {winVista testfile testchmod knownMsvcBug notWine} -body {
} -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

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 {winVista testfile testchmod knownMsvcBug notWine} -body {
} -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 notWine} -body {
} -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 {winVista testfile testchmod knownMsvcBug notWine} -body {
} -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

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 {winVista testfile testchmod knownMsvcBug notWine} -body {
} -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

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} -setup {
test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -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




︙


1126
1127
1128
1129
1130
1131
1132
1133

1134
1135
1136
1137
1138
1139
1140
1141

1142
1143
1144
1145
1146
1147
1148

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 notWine} -setup {
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 notWine} -setup {
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

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 notWine} -setup {
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

1
2
3
4
5
6


7
8
9
10
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.
# 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 Tcltest [info patchlevel]]
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 {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
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

1
2
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.
# 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 Tcltest [info patchlevel]]
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

1
2
3
4
5
6
7
8


9
10
11
12
13
14
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.
# 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 Tcltest [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    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 {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
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

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
    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

1
2
3
4
5
6


7
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 (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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 Tcltest [info patchlevel]]
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 knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
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

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 knownMsvcBug} {
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

1
2
3
4
5
6


7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22





23
24
25
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 (c) 1996-1998 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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

# 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
    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 [::tcl::pkgconfig get zipfile,runtime]]
    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

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

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.
# 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

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
    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

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)
    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

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} {
    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


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.
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.

The resulting documentation can be found at
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
    /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

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.
# 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

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.
# 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

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.
# 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

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) 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

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
    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

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 {[lsearch -exact $hooks($intf) $name] >= 0} {
	    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

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 $file
	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

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 {[string length [namespace which lassign]] == 0} {
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

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.
# 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

8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
26
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.
# 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 0644
		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 0755
	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

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.
# 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

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.
# 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

1
2
3
4
5
6
7
8
9
10

11
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
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]
	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

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
            		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 0755
      	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

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.
# 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

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]
	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

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.
# 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

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
	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

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
	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

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 "contents.htm"
	return "index.html"
    }
}

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]]"
    #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 <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"
    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>"
    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>"
		lappend subs "<a href=\"${level}$subdir/[indexfile]\">$name</a>"
	    }
	}
	append out "\n<H3>[join $subs { | }]</H3>"
	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 "&#8220;" \
	\u201d "&#8221;"
	\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;" \
	    {\(+-}	"&#177;" \
	    {\(Ye}	"&yen;" \
	    {\(bb}	"&brvbar;" \
	    {\(sc}	"&sect;" \
	    {\(ad}	"&die;" \
	    {\(co}	"&copy;" \
	    {\(em}	"&#8212;" \
	    {\(en}	"&#8211;" \
	    {\(fm}	"&#8242;" \
	    {\(mc}	"&#181;" \
	    {\(mu}	"&#215;" \
	    {\(mi}	"&#8722;" \
	    {\(->}	"<font size=\"+1\">&#8594;</font>" \
	    {\(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}	"&#8226;" \
	    {\(bu}	"&bull;" \
	    {\*(qo}	"&ocirc;" \
	    ]
    # 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 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
	    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
		{\1<tt>\2</tt>\3} text]} continue
	# B R
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
		{\1<B>\2</B>\3} text]} continue
		{\1<b>\2</b>\3} text]} continue
	# B I
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
		{\1<B>\2</B>\\fI\3} text]} continue
		{\1<b>\2</b>\\fI\3} text]} continue
	# I R
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
		{\1<I>\2</I>\3} text]} continue
		{\1<i>\2</i>\3} text]} continue
	# I B
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
		{\1<I>\2</I>\\fB\3} text]} continue
		{\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

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).htm#$here\" NAME=\"$there\">$text</A>"
    return "<A NAME=\"$here\">$text</A>"
	    "<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

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).htm#$here\">$switch, $name, $class</A>"
	"<a href=\"$manual(name).html#$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>"
	"<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)
	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>"
    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>
    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

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>
	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

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>
    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
	    man-puts <p>$rest
	    output-IP-list .RS .IP $rest2
	}
	if {[match-text .RE .sp .RS @rest .RE]} {
	    man-puts <P>$rest
	    man-puts <p>$rest
	    return
	}
	if {[next-op-is .RE rest]} {
	    return
	}
    }
    man-puts <DL><DD>
    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

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>
    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>
	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>"
		    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>
	man-puts </dl>
    } else {
	# labelled list, make contents
	if {$context ne ".SH" && $context ne ".SS"} {
	    man-puts <P>
	    man-puts <p>
	}
	set dl "<DL class=\"[string tolower $manual(section)]\">"
	set enddl "</DL>"
	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>"
		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>"
			    man-puts "$para<dt>$rest<dd>"
			} elseif {[regexp {^\[([\da-f]+)\]$} $rest -> value]} {
			    man-puts "$para<LI value=\"$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>"
			    man-puts "$para<li value=\"$value\">"
			} elseif {"&bull;" eq $rest} {
			    man-puts "$para<li>"
			} else {
			    man-puts "$para<DT>[long-toc $rest]<DD>"
			    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

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>"
			    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"
				man-puts "$enddl<p>$rest$dl"
				backup-text 1
				set para {}
				break
			    }
			    man-puts "<P>$rest"
			    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

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>
	    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

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>"
    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
    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

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>"
	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

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).htm\">$ref</A>"
		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

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.htm\">$ref</A>"
	    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.htm\">$ref</A>"
	    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.htm\">$ref</A>"
	    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

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.htm\">$ref</A>"
    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

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>
	##    <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>}
	    anchor     {<a }	end-anchor {</a>}
	    quote      {``}	end-quote  {''}
	    bold       {<B>}	end-bold   {</B>}
	    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

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>
			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

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>"
		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>
	    # 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>"
		man-puts "<h3>[long-toc $manual(section)]</h3>"
	    } else {
		man-puts "<H4>[long-toc $manual(section)]</H4>"
		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>
		    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>
			    #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>
				set spaces <tt>$spaces</tt>
			    }
			    man-puts $spaces$more<BR>
			    man-puts $spaces$more<br>
			    if {$manual(wing-file) in {TclLib TkLib}} {
				lappend manual(section-toc) <DD>$more
				lappend manual(section-toc) <dd>$more
			    }
			}
		    }
		    lappend manual(section-toc) </DL>
		    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>.*</b>$} $cr]} {
				set cr <b>$cr</b>
			    }
			    if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
				set cr <B>$name</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

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).htm]
				    $manual(wing-file)/$manual(name).html]
			    set initial [string toupper [string index $key 0]]
			    lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
			    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

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>
	    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 "<dt><b>[std-option-toc $option $targetPage]</b>"
	    }
	    man-puts </DL>
	    lappend manual(section-toc) </DL>
	    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>
	    man-puts <p>
	}
	.RS {
	    output-RS-list
	    return
	}
	.br {
	    man-puts <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>
		#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>"
		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>
		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>
		    man-puts $more<br>
		}
	    } elseif {[match-text .RS @more .RE .fi]} {
		man-puts <DL><DD>
		man-puts <dl><dd>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		    man-puts $more<br>
		}
		man-puts </DL>
		man-puts </dl>
	    } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} {
		man-puts <DL><DD>
		man-puts <dl><dd>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		    man-puts $more<br>
		}
		man-puts <DL><DD>
		man-puts <dl><dd>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		    man-puts $more2<br>
		}
		man-puts </DL></DL>
		man-puts </dl></dl>
	    } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} {
		man-puts <DL><DD>
		man-puts <dl><dd>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		    man-puts $more<br>
		}
		man-puts <DL><DD>
		man-puts <dl><dd>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		    man-puts $more2<br>
		}
		man-puts </DL><DD>
		man-puts </dl><dd>
		foreach more3 [split $more3 \n] {
		    man-puts $more3<BR>
		    man-puts $more3<br>
		}
		man-puts </DL>
		man-puts </dl>
	    } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} {
		man-puts <P><DL><DD>
		man-puts <p><dl><dd>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		    man-puts $more<br>
		}
		man-puts <DL><DD>
		man-puts <dl><dd>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		    man-puts $more2<br>
		}
		man-puts </DL></DL><P>
		man-puts </dl></dl><p>
	    } elseif {[match-text .RS .sp @more .sp .RE .fi]} {
		man-puts <P><DL><DD>
		man-puts <p><dl><dd>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		    man-puts $more<br>
		}
		man-puts </DL><P>
		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

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
    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>"
	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>"
	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

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

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>]
	    [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

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.htm)]} {
	    set tooltip $manual(tooltip-$manual(wing-file)/$tail.htm)
	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.htm\" title=\"[subst $tooltip]\">$name</a> </td>"
		"<td> <a href=\"$tail.html\" title=\"[subst $tooltip]\">$name</a> </td>"
	} else {
	    append rows([expr {$n%$nrows}]) \
		"<td> <a href=\"$tail.htm\">$name</a> </td>"
		"<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>"
    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

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)."
	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

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]} {
		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

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 {}} {
	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} {
	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"
	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 {$tkdir ne ""} {
	    if {$major eq ""} {
		# obtain version from generic header if we can:
		lassign [getversion [file join $tcltkdir $tcldir generic tk.h]] major minor
		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} {
	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 "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

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"
    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;
	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;
	color:             #11577B;
	border-bottom:     $hBd;
	margin-top:        0px;
    }
    css-style h2 {
	font-size:         14px;
	color:             #11577b;
	background-color:  #c5dce8;
	color:             #11577B;
	background-color:  #C5DCE8;
	padding-left:      1em;
	border:            1px solid #6A6A6A;
    }
    css-style h3 h4 {
	color:             #1674A4;
	background-color:  #e8f2f6;
	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;
	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 #999;
	border-top: 1px solid #999999;
    }
    css-style .copy {
	background-color:  #f6fcfc;
	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

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\">"
    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

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.htm\">$a</A>"
	    lappend keyheader "<a href=\"$a.html\">$a</a>"
	} else {
	    # No keywords for this letter
	    lappend keyheader $a
	}
    }
    set keyheader <H3>[join $keyheader " |\n"]</H3>
    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]
	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\">"
	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>"
	    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>"
		    lappend refs "<a href=\"../$file\" title=\"$tooltip\">$name</a>"
		} else {
		    lappend refs "<A HREF=\"../$file\">$name</A>"
		    lappend refs "<a href=\"../$file\">$name</a>"
		}
	    }
	    puts $afp "[join $refs {, }]</DD>"
	    puts $afp "[join $refs {, }]</dd>"
	}
	puts $afp "</DL>"
	puts $afp "</dl>"
	# insert merged copyrights
	puts $afp [copyout $manual(merge-copyrights)]
	puts $afp "</BODY></HTML>"
	puts $afp "</body></html>"
	close $afp
    }
    # insert merged copyrights
    puts $keyfp [copyout $manual(merge-copyrights)]
    puts $keyfp "</BODY></HTML>"
    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>"
    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>"
    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

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).htm w]
	    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>"
	    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

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

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]]
		    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

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

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."] \
	     "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."] \
	     "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

1
2

3
4
5
6
7
8
9
10



-
+








#include <tcl.h>

extern DLLEXPORT Tcl_PackageInitProc Tsdperf_Init;
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

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.
# 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

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
    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 by Scriptics Corporation.
 * 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

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_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

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

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)/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

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

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}/reg
	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

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_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

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

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-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; \




︙


1046
1047
1048
1049
1050
1051
1052
1053

1054
1055
1056


1057
1058

1059
1060
1061
1062
1063
1064
1065

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.3 as a Tcl Module"
	@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.3.tm"
	@echo "Installing package platform 1.0.14 as a Tcl Module"
		"$(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.14.tm"
		"$(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

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)\"" \
		-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




︙


1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536

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_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)




︙


1736
1737
1738
1739
1740
1741
1742



1743
1744
1745
1746
1747
1748
1749

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

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
tclEpollNotfy.o: $(UNIX_DIR)/tclEpollNotfy.c $(UNIX_DIR)/tclUnixNotfy.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclEpollNotfy.c

tclKqueueNotfy.o: $(UNIX_DIR)/tclKqueueNotfy.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
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

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)/tclStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLibTbl.c

tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) $(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) $(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

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 reg dde tcltest platform
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

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.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 \




︙


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

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)/Makefile.in $(TOOL_DIR)/README \
	$(DIST_INSTALL_DATA) $(TOOL_DIR)/README $(TOOL_DIR)/*.c $(TOOL_DIR)/*.svg \
		$(TOOL_DIR)/configure $(TOOL_DIR)/configure.ac \
		$(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \
		$(TOOL_DIR)/*.tcl $(TOOL_DIR)/*.bmp \
		$(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \
		$(DISTDIR)/tools
		$(TOOL_DIR)/valgrind_suppress $(DISTDIR)/tools
	chmod 755 $(DISTDIR)/tools/checkLibraryDoc.tcl \
		$(DISTDIR)/tools/configure $(DISTDIR)/tools/findBadExternals.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

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: install-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile
.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

1
2

3
4
5

6
7
8
9
10
11
12
13
14
15
16
17

18
19
20
21
22
23
24
25

26
27
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.69 for tcl 9.0.
# Generated by GNU Autoconf 2.70 for tcl 9.0.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
# 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 -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
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
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
# 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 --'
IFS=" ""	$as_nl"

elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
PS1='$ '
PS2='> '
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
PS4='+ '
      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

# Ensure predictable behavior from utilities with locale-dependent output.
LC_ALL=C
export LC_ALL
    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
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 test "${PATH_SEPARATOR+set}" != set; then
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


# 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
  case $as_dir in #(((
  test -z "$as_dir" && as_dir=.
    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
    '') 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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  printf "%s\n" "$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




︙


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

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'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
as_fn_exit 255
printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
  fi
  # We don't want this to propagate to other subprocesses.
          { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; 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
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 :
if ( set x; as_fn_ret_success y && test x = \"\$1\" )
then :

else
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 :
  if (eval "$as_required") 2>/dev/null
then :
  as_have_required=yes
else
else $as_nop
  as_have_required=no
fi
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null
then :

else
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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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
	     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 :
		    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_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
		   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
$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 :
  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
IFS=$as_save_IFS
fi


      if test "x$CONFIG_SHELL" != x; then :
      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
printf "%s\n" "$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."
    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
    $as_echo "$0: Please tell [email protected] about your system,
    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

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=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *\'*) 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 ||
$as_echo X"$as_dir" |
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

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 :
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
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 :
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null
then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else
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
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  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

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 ||
$as_echo X/"$0" |
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

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" ||
    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
    { 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

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 <stdio.h>
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
#include <stddef.h>
#ifdef HAVE_STDIO_H
# include <stdio.h>
#endif
#ifdef HAVE_SYS_STAT_H
#ifdef HAVE_STDLIB_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_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

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

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

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

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_zipfs
enable_framework
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

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

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

  # 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=*)




︙


899
900
901
902
903
904
905
906

907
908

909
910
911
912
913
914
915

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"
      as_fn_error $? "invalid feature name: \`$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    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

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"
      as_fn_error $? "invalid feature name: \`$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    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

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

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"
      as_fn_error $? "invalid package name: \`$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    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"
      as_fn_error $? "invalid package name: \`$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    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

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.
    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
    printf "%s\n" "$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
      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" ;;
    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
    *)     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
		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

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 ||
$as_echo X"$as_myself" |
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

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

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-zipfs          build with Zipfs support (default: on)
  --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:
  --with-encoding         encoding for configuration values (default: utf-8)
                          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

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=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  ac_dir_suffix=/`printf "%s\n" "$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|/||'`
  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

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 guested configure.
    # 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
      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
      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.69
generated by GNU Autoconf 2.70

Copyright (C) 2012 Free Software Foundation, Inc.
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
  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\""
$as_echo "$ac_try_echo"; } >&5
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
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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 :
       } && test -s conftest.$ac_objext
then :
  ac_retval=0
else
  $as_echo "$as_me: failed program was:" >&5
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$ac_exeext
  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\""
$as_echo "$ac_try_echo"; } >&5
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
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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 :
then :
  ac_retval=0
else
  $as_echo "$as_me: failed program was:" >&5
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\""
$as_echo "$ac_try_echo"; } >&5
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
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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 :
then :
  ac_retval=0
else
  $as_echo "$as_me: failed program was:" >&5
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_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
  { 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.
   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>
#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 ()
main (void)
{
return $2 ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  eval "$3=yes"
else
else $as_nop
  eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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; }
	       { 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_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
  { 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  eval "$3=yes"
else
else $as_nop
  eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
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
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
	       { 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
  { $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
  { 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 ()
main (void)
{
if (sizeof ($2))
	 return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main ()
main (void)
{
if (sizeof (($2)))
	    return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :

else
else $as_nop
  eval "$3=yes"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
	       { 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
  { $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
  { 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 ()
main (void)
{
static $2 ac_aggr;
if (ac_aggr.$3)
return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  eval "$4=yes"
else
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$5
int
main ()
main (void)
{
static $2 ac_aggr;
if (sizeof ac_aggr.$3)
return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  eval "$4=yes"
else
else $as_nop
  eval "$4=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
eval ac_res=\$$4
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
	       { 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.69.  Invocation command line was
generated by GNU Autoconf 2.70.  Invocation command line was

  $ $0 $@
  $ $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

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 #(((
  test -z "$as_dir" && as_dir=.
    $as_echo "PATH: $as_dir"
    '') 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

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=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
      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

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

    $as_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_*) { $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;} ;;
      *_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

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

    $as_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=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      esac
      $as_echo "$ac_var='\''$ac_val'\''"
      printf "%s\n" "$ac_var='\''$ac_val'\''"
    done | sort
    echo

    if test -n "$ac_subst_files"; then
      $as_echo "## ------------------- ##
      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=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	*\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	esac
	$as_echo "$ac_var='\''$ac_val'\''"
	printf "%s\n" "$ac_var='\''$ac_val'\''"
      done | sort
      echo
    fi

    if test -s confdefs.h; then
      $as_echo "## ----------- ##
      printf "%s\n" "## ----------- ##
## 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"
      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

$as_echo "/* confdefs.h */" > confdefs.h
printf "%s\n" "/* confdefs.h */" > confdefs.h

# Predefined preprocessor variables.

cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_URL "$PACKAGE_URL"
printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h
_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_files="$CONFIG_SITE"
    -*)  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_files="$prefix/share/config.site $prefix/etc/config.site"
  ac_site_file2=$prefix/etc/config.site
else
  ac_site_file1=$ac_default_prefix/share/config.site
  ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
  ac_site_file2=$ac_default_prefix/etc/config.site
fi

for ac_site_file in "$ac_site_file1" "$ac_site_file2"
for ac_site_file in $ac_site_files
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;}
  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" \
      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
      || { { 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
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
$as_echo "$as_me: loading cache $cache_file" >&6;}
    { 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
  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
$as_echo "$as_me: creating cache $cache_file" >&6;}
  { 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,)
      { $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;}
      { 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)
      { $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;}
      { 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
	  { $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;}
	  { 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
	  { $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;}
	  { 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
	{ $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;}
	{ 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=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
    *\'*) 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
  { $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
  { 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

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?
#------------------------------------------------------------------------


    { $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; }
    { 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+set}" = set; then :
if test ${enable_man_symlinks+y}
then :
  enableval=$enable_man_symlinks; test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks"
else
else $as_nop
  enableval="no"
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
$as_echo "$enableval" >&6; }
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
printf "%s\n" "$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; }
    { 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+set}" = set; then :
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
else $as_nop
  enableval="no"
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
$as_echo "$enableval" >&6; }
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
printf "%s\n" "$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; }
	{ 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"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $Z" >&5
$as_echo "$Z" >&6; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $Z" >&5
printf "%s\n" "$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; }
    { 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+set}" = set; then :
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
else $as_nop
  enableval="no"
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
$as_echo "$enableval" >&6; }
    { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
printf "%s\n" "$ac_ct_CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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:)
{ $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;}
{ 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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
  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
    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+' '}$@"
    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; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
printf "%s\n" "$ac_ct_CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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:)
{ $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;}
{ 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" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
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.
$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
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; do
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\""
$as_echo "$ac_try_echo"; } >&5
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
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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 ()
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.
{ $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[^ ]*//'`
{ 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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$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 :
  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+set}" = set && test "$ac_cv_exeext" != no;
	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
else $as_nop
  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
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

{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
{ { 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_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else $as_nop
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "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; }
{ 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
$as_echo_n "checking for suffix of executables... " >&6; }
{ 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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$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 :
  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_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
$as_echo "$ac_cv_exeext" >&6; }
{ 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 ()
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.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
$as_echo_n "checking whether we are cross compiling... " >&6; }
{ 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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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
	{ { $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.
	{ { 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
$as_echo "$cross_compiling" >&6; }
{ 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
{ $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
{ 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 ()
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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$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 :
  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_echo "$as_me: failed program was:" >&5
else $as_nop
  printf "%s\n" "$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;}
{ { 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
$as_echo "$ac_cv_objext" >&6; }
{ 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
{ $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
{ 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 ()
main (void)
{
#ifndef __GNUC__
       choke me
#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_compiler_gnu=yes
else
else $as_nop
  ac_compiler_gnu=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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+set}
ac_test_CFLAGS=${CFLAGS+y}
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
{ 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_prog_cc_g=yes
else
else $as_nop
  CFLAGS=""
      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :

else
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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
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
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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
{ 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
{ $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
{ 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.  */
#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;
}

$ac_c_conftest_c89_program
/* 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 :
  if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_prog_cc_c89=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext
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)
    { $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; } ;;
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 :
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


{ $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
{ 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 () {return 0; }
$ac_kw foo_t foo () {return 0; }
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 :
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
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

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
{ $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; }
{ 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 ${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"
  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.
  # 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>
#include <limits.h>
#else
# include <assert.h>
#endif
		     Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :
if ac_fn_c_try_cpp "$LINENO"
then :

else
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 :
if ac_fn_c_try_cpp "$LINENO"
then :
  # Broken: success on invalid input.
continue
else
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 :
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; }
{ 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.
  # 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>
#include <limits.h>
#else
# include <assert.h>
#endif
		     Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :
if ac_fn_c_try_cpp "$LINENO"
then :

else
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 :
if ac_fn_c_try_cpp "$LINENO"
then :
  # Broken: success on invalid input.
continue
else
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 :
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;}
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


{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    for ac_prog in grep ggrep; do
    '') 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"
      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"
  printf %s 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"
    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

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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
$as_echo "$ac_cv_path_GREP" >&6; }
{ 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"


{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    for ac_prog in egrep; do
    '') 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"
      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"
  printf %s 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"
    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

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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
$as_echo "$ac_cv_path_EGREP" >&6; }
{ 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"


{ $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
    { 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 ()
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

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 :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_dirent_h=yes
else
else $as_nop
  tcl_cv_dirent_h=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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; }
{ 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

$as_echo "#define NO_DIRENT_H 1" >>confdefs.h
printf "%s\n" "#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 :
    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
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 :
  $EGREP "strtol" >/dev/null 2>&1
then :

else
else $as_nop
  tcl_ok=0
fi
rm -f conftest*
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 :
  $EGREP "strtoul" >/dev/null 2>&1
then :

else
else $as_nop
  tcl_ok=0
fi
rm -f conftest*
rm -rf conftest*

    if test $tcl_ok = 0; then

$as_echo "#define NO_STDLIB_H 1" >>confdefs.h
printf "%s\n" "#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 :
    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
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 "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 :
  $EGREP "strerror" >/dev/null 2>&1
then :

else
else $as_nop
  tcl_ok=0
fi
rm -f conftest*
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

$as_echo "#define NO_STRING_H 1" >>confdefs.h
printf "%s\n" "#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 :
    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
else $as_nop

$as_echo "#define NO_SYS_WAIT_H 1" >>confdefs.h
printf "%s\n" "#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 :
    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
else $as_nop

$as_echo "#define NO_DLFCN_H 1" >>confdefs.h
printf "%s\n" "#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 :
    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
  cat >>confdefs.h <<_ACEOF
#define HAVE_SYS_PARAM_H 1
then :
  printf "%s\n" "#define HAVE_SYS_PARAM_H 1" >>confdefs.h
_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
    { 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_cc_pipe=yes
else
else $as_nop
  tcl_cv_cc_pipe=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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+set}" = set; then :
if test ${with_encoding+y}
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}"
printf "%s\n" "#define TCL_CFGVAL_ENCODING \"${with_tcencoding}\"" >>confdefs.h
_ACEOF

    else

$as_echo "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h
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 :
if test "x$ac_cv_func_sin" = xyes
then :
  MATH_LIBS=""
else
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.
    #--------------------------------------------------------------------

    { $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
    { 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 ()
main (void)
{
return main ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_inet_main=yes
else
else $as_nop
  ac_cv_lib_inet_main=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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_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 :
    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 :


$as_echo "#define HAVE_NET_ERRNO_H 1" >>confdefs.h
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

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 :
if test "x$ac_cv_func_connect" = xyes
then :
  tcl_checkSocket=0
else
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 :
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
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.  */
#ifdef __cplusplus
extern "C"
#endif
char setsockopt ();
int
main ()
main (void)
{
return setsockopt ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_socket_setsockopt=yes
else
else $as_nop
  ac_cv_lib_socket_setsockopt=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
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 :
if test "x$ac_cv_func_accept" = xyes
then :
  tcl_checkNsl=0
else
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 :
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
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.  */
#ifdef __cplusplus
extern "C"
#endif
char gethostbyname ();
int
main ()
main (void)
{
return gethostbyname ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_nsl_gethostbyname=yes
else
else $as_nop
  ac_cv_lib_nsl_gethostbyname=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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



$as_echo "#define _REENTRANT 1" >>confdefs.h
printf "%s\n" "#define _REENTRANT 1" >>confdefs.h


$as_echo "#define _THREAD_SAFE 1" >>confdefs.h
printf "%s\n" "#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
    { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
main (void)
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_pthread_pthread_mutex_init=yes
else
else $as_nop
  ac_cv_lib_pthread_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
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]
	{ $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
	{ 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.  */
#ifdef __cplusplus
extern "C"
#endif
char __pthread_mutex_init ();
int
main ()
main (void)
{
return __pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_pthread___pthread_mutex_init=yes
else
else $as_nop
  ac_cv_lib_pthread___pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
else $as_nop
  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
	{ 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.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
main (void)
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_pthreads_pthread_mutex_init=yes
else
else $as_nop
  ac_cv_lib_pthreads_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
else $as_nop
  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
	    { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
main (void)
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_c_pthread_mutex_init=yes
else
else $as_nop
  ac_cv_lib_c_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
else $as_nop
  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
		{ 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.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
main (void)
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_c_r_pthread_mutex_init=yes
else
else $as_nop
  ac_cv_lib_c_r_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
else $as_nop
  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;}
		    { 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"
    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
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
#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 :
if test "x$ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" = xyes
then :
  ac_have_decl=1
else
else $as_nop
  ac_have_decl=0
fi

cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE $ac_have_decl
printf "%s\n" "#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE $ac_have_decl" >>confdefs.h
_ACEOF
if test $ac_have_decl = 1; then :
if test $ac_have_decl = 1
then :
  tcl_ok=yes
else
else $as_nop
  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; }
    { 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+set}" = set; then :
if test ${enable_shared+y}
then :
  enableval=$enable_shared; tcl_ok=$enableval
else
else $as_nop
  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; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared" >&5
printf "%s\n" "shared" >&6; }
	SHARED_BUILD=1
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
$as_echo "static" >&6; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: static" >&5
printf "%s\n" "static" >&6; }
	SHARED_BUILD=0

$as_echo "#define STATIC_BUILD 1" >>confdefs.h
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.
#--------------------------------------------------------------------


    { $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
    { 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"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
$as_echo "$TCLSH_PROG" >&6; }
	{ 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=""
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
$as_echo "No tclsh found on PATH" >&6; }
	{ 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_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_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 :
if test "x$ac_cv_type_gz_header" = xyes
then :

else
else $as_nop
  zlib_ok=no
fi

else
else $as_nop

  zlib_ok=no
fi


if test $zlib_ok = yes; then :
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
  { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char deflateSetHeader ();
int
main ()
main (void)
{
return deflateSetHeader ();
  ;
  return 0;
}
_ACEOF
for ac_lib in '' z; do
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 :
  if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_search_deflateSetHeader=$ac_res
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext
  if ${ac_cv_search_deflateSetHeader+:} false; then :
  if test ${ac_cv_search_deflateSetHeader+y}
then :
  break
fi
done
if ${ac_cv_search_deflateSetHeader+:} false; then :
if test ${ac_cv_search_deflateSetHeader+y}
then :

else
else $as_nop
  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; }
{ 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 :
if test "$ac_res" != no
then :
  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"

else
else $as_nop

    zlib_ok=no

fi

fi
if test $zlib_ok = no; then :
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
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+set}" = set; then :
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_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_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 :
if test "x$ac_cv_type_mp_int" = xyes
then :

else
else $as_nop
  libtommath_ok=no
fi

else
else $as_nop

	libtommath_ok=no
fi


    if test $libtommath_ok = yes; then :
    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
	{ 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.  */
#ifdef __cplusplus
extern "C"
#endif
char mp_log_u32 ();
int
main ()
main (void)
{
return mp_log_u32 ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_tommath_mp_log_u32=yes
else
else $as_nop
  ac_cv_lib_tommath_mp_log_u32=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
else $as_nop

    libtommath_ok=no
fi

fi
fi
if test $libtommath_ok = yes; then :
if test $libtommath_ok = yes
then :


$as_echo "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h
printf "%s\n" "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h


else
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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
$as_echo "$RANLIB" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
printf "%s\n" "$RANLIB" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
$as_echo "$ac_ct_RANLIB" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
printf "%s\n" "$ac_ct_RANLIB" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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:)
{ $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;}
{ 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?

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5
$as_echo_n "checking if 64bit support is requested... " >&6; }
    { 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+set}" = set; then :
if test ${enable_64bit+y}
then :
  enableval=$enable_64bit; do64bit=$enableval
else
else $as_nop
  do64bit=no
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5
$as_echo "$do64bit" >&6; }
    { 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?

    { $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; }
    { 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+set}" = set; then :
if test ${enable_64bit_vis+y}
then :
  enableval=$enable_64bit_vis; do64bitVIS=$enableval
else
else $as_nop
  do64bitVIS=no
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bitVIS" >&5
$as_echo "$do64bitVIS" >&6; }
    { 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 :
    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
    { 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 ()
main (void)
{
f();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_cc_visibility_hidden=yes
else
else $as_nop
  tcl_cv_cc_visibility_hidden=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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 :


$as_echo "#define MODULE_SCOPE extern __attribute__((__visibility__(\"hidden\")))" >>confdefs.h
printf "%s\n" "#define MODULE_SCOPE extern __attribute__((__visibility__(\"hidden\")))" >>confdefs.h


$as_echo "#define HAVE_HIDDEN 1" >>confdefs.h
printf "%s\n" "#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; }
    { 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+set}" = set; then :
if test ${enable_rpath+y}
then :
  enableval=$enable_rpath; doRpath=$enableval
else
else $as_nop
  doRpath=yes
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doRpath" >&5
$as_echo "$doRpath" >&6; }
    { 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.


    { $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
    { 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
		{ $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;}
		{ 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5
$as_echo "$tcl_cv_sys_version" >&6; }
{ 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.

    { $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
    { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char dlopen ();
int
main ()
main (void)
{
return dlopen ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_dl_dlopen=yes
else
else $as_nop
  ac_cv_lib_dl_dlopen=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
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

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 :
    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"
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -fextended-identifiers"
		;;
	esac


else
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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
$as_echo "$AR" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
printf "%s\n" "$AR" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
$as_echo "$ac_ct_AR" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
printf "%s\n" "$ac_ct_AR" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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:)
{ $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;}
{ 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 :
    if test "x${SHLIB_VERSION}" = x
then :
  SHLIB_VERSION="1.0"
fi
    case $system in
	AIX-*)
	    if test "$GCC" != "yes"; then :
	    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; }
		{ 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 "$do64bit" = yes
then :

		if test "$GCC" = 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;}
		    { 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
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 :
	    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 :
		if test "$GCC" = yes
then :

		    CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'

else
else $as_nop

		    CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}'

fi
		LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'

else
else $as_nop

		if test "$GCC" = yes; then :
		if test "$GCC" = yes
then :

		    SHLIB_LD='${CC} -shared -Wl,-bexpall'

else
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

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.
	    #-----------------------------------------------------------
	    { $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
	    { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char inet_ntoa ();
int
main ()
main (void)
{
return inet_ntoa ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_bind_inet_ntoa=yes
else
else $as_nop
  ac_cv_lib_bind_inet_ntoa=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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

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_*)
	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]"
	    { $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
	    { 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_cygwin=no
else
else $as_nop
  ac_cv_cygwin=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5
$as_echo "$ac_cv_cygwin" >&6; }
{ 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

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"
	    { $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
	    { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char inet_ntoa ();
int
main ()
main (void)
{
return inet_ntoa ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_network_inet_ntoa=yes
else
else $as_nop
  ac_cv_lib_network_inet_ntoa=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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

$as_echo "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h
printf "%s\n" "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h


$as_echo "#define _XOPEN_SOURCE 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 :
	    if test "`uname -m`" = ia64
then :

		SHLIB_SUFFIX=".so"

else
else $as_nop

		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
	    { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char shl_load ();
int
main ()
main (void)
{
return shl_load ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_dld_shl_load=yes
else
else $as_nop
  ac_cv_lib_dld_shl_load=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
else $as_nop
  tcl_ok=no
fi

	    if test "$tcl_ok" = yes; then :
	    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 :
	    if test "$GCC" = yes
then :

		SHLIB_LD='${CC} -shared'
		LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}

else
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 "$do64bit" = "yes"
then :

		if test "$GCC" = 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 :
			    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;}
			    { 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
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"
	    { $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
	    { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char shl_load ();
int
main ()
main (void)
{
return shl_load ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_dld_shl_load=yes
else
else $as_nop
  ac_cv_lib_dld_shl_load=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
else $as_nop
  tcl_ok=no
fi

	    if test "$tcl_ok" = yes; then :
	    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

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 :
	    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 :
	    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 :
	    if test "$GCC" = yes
then :

		CFLAGS="$CFLAGS -mabi=n32"
		LDFLAGS="$LDFLAGS -mabi=n32"

else
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

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 :
	    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 "$do64bit" = yes
then :

	        if test "$GCC" = 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;}
	            { 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
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

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 :
	    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 :
	    if test "`uname -m`" = "alpha"
then :
  CFLAGS="$CFLAGS -mieee"
fi
	    if test $do64bit = yes; then :
	    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
		{ 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_cc_m64=yes
else
else $as_nop
  tcl_cv_cc_m64=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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 :
	    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 :
	    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 :
	    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

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 :
	    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 :
	    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

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 :
	    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
			{ 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_cc_arch_ppc64=yes
else
else $as_nop
  tcl_cv_cc_arch_ppc64=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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)
			{ $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
			{ 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_cc_arch_x86_64=yes
else
else $as_nop
  tcl_cv_cc_arch_x86_64=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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;;
		    *)
			{ $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;};;
			{ 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
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 :
		    && 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
	    { 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 ()
main (void)
{
int i;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_ld_single_module=yes
else
else $as_nop
  tcl_cv_ld_single_module=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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"
	    { $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
	    { 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 ()
main (void)
{
int i;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_ld_search_paths_first=yes
else
else $as_nop
  tcl_cv_ld_search_paths_first=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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 :
	    if test "$tcl_cv_cc_visibility_hidden" != yes
then :


$as_echo "#define MODULE_SCOPE __private_extern__" >>confdefs.h
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"

$as_echo "#define MAC_OSX_TCL 1" >>confdefs.h
printf "%s\n" "#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; }
	    { 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+set}" = set; then :
if test ${enable_corefoundation+y}
then :
  enableval=$enable_corefoundation; tcl_corefoundation=$enableval
else
else $as_nop
  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 :
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_corefoundation" >&5
printf "%s\n" "$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
		{ 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 :
		    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 ()
main (void)
{
CFBundleRef b = CFBundleGetMainBundle();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_lib_corefoundation=yes
else
else $as_nop
  tcl_cv_lib_corefoundation=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
		    if test "$fat_32_64" = yes; then :
		    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 :
{ 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"

$as_echo "#define HAVE_COREFOUNDATION 1" >>confdefs.h
printf "%s\n" "#define HAVE_COREFOUNDATION 1" >>confdefs.h


else
else $as_nop
  tcl_corefoundation=no
fi
		if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then :
		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
		    { 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 ()
main (void)
{
CFBundleRef b = CFBundleGetMainBundle();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_lib_corefoundation_64=yes
else
else $as_nop
  tcl_cv_lib_corefoundation_64=no
fi
rm -f core conftest.err conftest.$ac_objext \
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
{ $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 :
{ 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 :


$as_echo "#define NO_COREFOUNDATION_64 1" >>confdefs.h
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

$as_echo "#define _OE_SOCKETS 1" >>confdefs.h
printf "%s\n" "#define _OE_SOCKETS 1" >>confdefs.h

	    ;;
	OSF1-V*)
	    # Digital OSF/1
	    SHLIB_CFLAGS=""
	    if test "$SHARED_BUILD" = 1; then :
	    if test "$SHARED_BUILD" = 1
then :

	        SHLIB_LD='ld -shared -expect_unresolved "*"'

else
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 :
	    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 :
	    if test "$GCC" = yes
then :
  CFLAGS="$CFLAGS -mieee"
else
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 :
	    if test "$GCC" = yes
then :

		LIBS="$LIBS -lpthread -lmach -lexc"

else
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

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 :
	    if test "$GCC" = yes
then :

		SHLIB_CFLAGS="-fPIC -melf"
		LDFLAGS="$LDFLAGS -melf -Wl,-Bexport"

else
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.


$as_echo "#define _REENTRANT 1" >>confdefs.h
printf "%s\n" "#define _REENTRANT 1" >>confdefs.h


$as_echo "#define _POSIX_PTHREAD_SEMANTICS 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 :
	    if test "$GCC" = yes
then :

		SHLIB_LD='${CC} -shared'
		CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}

else
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.


$as_echo "#define _REENTRANT 1" >>confdefs.h
printf "%s\n" "#define _REENTRANT 1" >>confdefs.h


$as_echo "#define _POSIX_PTHREAD_SEMANTICS 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 :
	    if test "$do64bit" = yes
then :

		arch=`isainfo`
		if test "$arch" = "sparcv9 sparc"; then :
		if test "$arch" = "sparcv9 sparc"
then :

		    if test "$GCC" = yes; then :
		    if test "$GCC" = yes
then :

			if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; 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;}
			    { 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
else $as_nop

			    do64bit_ok=yes
			    CFLAGS="$CFLAGS -m64 -mcpu=v9"
			    LDFLAGS="$LDFLAGS -m64 -mcpu=v9"
			    SHLIB_CFLAGS="-fPIC"

fi

else
else $as_nop

			do64bit_ok=yes
			if test "$do64bitVIS" = yes; then :
			if test "$do64bitVIS" = yes
then :

			    CFLAGS="$CFLAGS -xarch=v9a"
			    LDFLAGS_ARCH="-xarch=v9a"

else
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
  if test "$arch" = "amd64 i386"; then :
else $as_nop
  if test "$arch" = "amd64 i386"
then :

		    if test "$GCC" = yes; 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;};;
				{ 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
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_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;}
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 :
	    if test "$GCC" = yes
then :
  use_sunmath=no
else
else $as_nop

		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 :
		{ 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 :

			{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
			{ 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_mongrel "$LINENO" "sunmath.h" "ac_cv_header_sunmath_h" "$ac_includes_default"
if test "x$ac_cv_header_sunmath_h" = xyes; then :
			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
else $as_nop

			{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
			{ 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 :
	    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 "$do64bit_ok" = yes
then :

		    if test "$arch" = "sparcv9 sparc"; 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 :
else $as_nop
  if test "$arch" = "amd64 i386"
then :

			SHLIB_LD="$SHLIB_LD -m64 -static-libgcc"

fi
fi

fi

else
else $as_nop

		if test "$use_sunmath" = yes; then :
		if test "$use_sunmath" = yes
then :
  textmode=textoff
else
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

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.
	    { $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
	    { 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 ()
main (void)
{
int i;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_ld_Bexport=yes
else
else $as_nop
  tcl_cv_ld_Bexport=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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 :
    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;}
	{ 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 :
    if test "$do64bit" = yes -a "$do64bit_ok" = yes
then :


$as_echo "#define TCL_CFG_DO64BIT 1" >>confdefs.h
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+set}" = set; then :
if test ${enable_load+y}
then :
  enableval=$enable_load; tcl_ok=$enableval
else
else $as_nop
  tcl_ok=yes
fi

    if test "$tcl_ok" = no; then :
    if test "$tcl_ok" = no
then :
  DL_OBJS=""
fi

    if test "x$DL_OBJS" != x; then :
    if test "x$DL_OBJS" != x
then :
  BUILD_DLTEST="\$(DLTEST_TARGETS)"
else
else $as_nop

	{ $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;}
	{ 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 :
    if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes
then :

	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*) ;;
	    CYGWIN_*|MINGW32_*|MSYS_*) ;;
	    HP_UX*) ;;
	    Darwin-*) ;;
	    IRIX*) ;;
	    Linux*|GNU*) ;;
	    NetBSD-*|OpenBSD-*) ;;
	    NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
	    OSF1-V*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac
fi

    if test "$tcl_cv_cc_visibility_hidden" != yes; then :
    if test "$tcl_cv_cc_visibility_hidden" != yes
then :


$as_echo "#define MODULE_SCOPE extern" >>confdefs.h
printf "%s\n" "#define MODULE_SCOPE extern" >>confdefs.h


fi

    if test "$SHARED_LIB_SUFFIX" = ""; then :
    if test "$SHARED_LIB_SUFFIX" = ""
then :

	SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
fi
    if test "$UNSHARED_LIB_SUFFIX" = ""; then :
    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 :
    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 :
        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
else $as_nop

            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'

fi

else
else $as_nop

        LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}

        if test "$RANLIB" = ""; then :
        if test "$RANLIB" = ""
then :

            MAKE_LIB='$(STLIB_LD) $@ ${OBJS}'

else
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 :
    if test "$RANLIB" = ""
then :

        MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}'

else
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 :
    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.
    # 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
    { 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 ()
main (void)
{

		  union foo { int i; double d; };
		  union foo f = (union foo) (int) 0;
		union foo { int i; double d; };
		union foo f = (union foo) (int) 0;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_cast_to_union=yes
else
else $as_nop
  tcl_cv_cast_to_union=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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
{ 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

$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h
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
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_mongrel "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default"
if test "x$ac_cv_header_stdbool_h" = xyes; then :
    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 :

$as_echo "#define HAVE_STDBOOL_H 1" >>confdefs.h
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

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








-
-
+
+
-











-
-
+
+

-
+
+

-
+








-
+

-
-
+
+

-
+





-
-
+
+







-
+





-
+


-
+





-
-
+
+

-
-
+
+





-
+







-
-
+
+


-
-
-
+
+
+
+




-
+






-
+
+

-
+





-
+






-
+
+

-
+


-
+

-
+




-
+





-
-
-
+
+
+
+




-
+






-
+
+

-
+





-
+






-
+
+

-
+


-
+

-
+




-
+





-
-
-
+
+
+
+




-
+






-
+
+

-
+





-
+






-
+
+

-
+


-
+

-
+




-
+





-
-
+
+

-
-
+
+




-
-
-
-
-
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
+


-
+





-
-
+
+
+

-
+




-
+

-
-
+
+

-
-
-
-
-
-
-
-

-
-
-
-
-
+
+
+
+
+
+






-
+






-
+
+

-
+


-
+

-
-
+
+


-
+



-
-
-
-
-
+
+
+
+
+
+






-
+







-
+
+

-
+


-
+

-
-
+
+


-
+



-
-
-
-
-
+
+
+
+
+
+





-
+







-
+
+

-
+


-
+

-
-
+
+


-
+



+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-


-

-
-
-
-
-
+
+
+
+
+
+





-
+







-
+
+

-
+


-
+






-
+

-
-
+
+

-
-
+
+









-
-
-
-
-
+
+
+
+
+
+










-
+
+















cat >>confdefs.h <<_ACEOF
#define TCL_SHLIB_EXT "${SHLIB_SUFFIX}"

printf "%s\n" "#define TCL_SHLIB_EXT \"${SHLIB_SUFFIX}\"" >>confdefs.h
_ACEOF











    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5
$as_echo_n "checking for build with symbols... " >&6; }
    { 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+set}" = set; then :
if test ${enable_symbols+y}
then :
  enableval=$enable_symbols; tcl_ok=$enableval
else
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)'

$as_echo "#define NDEBUG 1" >>confdefs.h
printf "%s\n" "#define NDEBUG 1" >>confdefs.h

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }

$as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h
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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5
$as_echo "yes (standard debugging)" >&6; }
	    { 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

$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h
printf "%s\n" "#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
printf "%s\n" "#define TCL_COMPILE_DEBUG 1" >>confdefs.h


$as_echo "#define TCL_COMPILE_STATS 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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5
$as_echo "enabled symbols mem compile debugging" >&6; }
	    { 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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5
$as_echo "enabled $tcl_ok debugging" >&6; }
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5
printf "%s\n" "enabled $tcl_ok debugging" >&6; }
	fi
    fi



$as_echo "#define MP_PREC 4" >>confdefs.h
printf "%s\n" "#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; }
    { 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 ${tcl_cv_flag__isoc99_source+:} false; then :
  $as_echo_n "(cached) " >&6
else
    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 ()
main (void)
{
char *p = (char *)strtoll; char *q = (char *)strtoull;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_flag__isoc99_source=no
else
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#define _ISOC99_SOURCE 1
#include <stdlib.h>
int
main ()
main (void)
{
char *p = (char *)strtoll; char *q = (char *)strtoull;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_flag__isoc99_source=yes
else
else $as_nop
  tcl_cv_flag__isoc99_source=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

    if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then

$as_echo "#define _ISOC99_SOURCE 1" >>confdefs.h
printf "%s\n" "#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
    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 ()
main (void)
{
struct stat64 buf; int i = stat64("/", &buf);
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_flag__largefile64_source=no
else
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#define _LARGEFILE64_SOURCE 1
#include <sys/stat.h>
int
main ()
main (void)
{
struct stat64 buf; int i = stat64("/", &buf);
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_flag__largefile64_source=yes
else
else $as_nop
  tcl_cv_flag__largefile64_source=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

    if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then

$as_echo "#define _LARGEFILE64_SOURCE 1" >>confdefs.h
printf "%s\n" "#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
    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 ()
main (void)
{
char *p = (char *)open64;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_flag__largefile_source64=no
else
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#define _LARGEFILE_SOURCE64 1
#include <sys/stat.h>
int
main ()
main (void)
{
char *p = (char *)open64;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_flag__largefile_source64=yes
else
else $as_nop
  tcl_cv_flag__largefile_source64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

    if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then

$as_echo "#define _LARGEFILE_SOURCE64 1" >>confdefs.h
printf "%s\n" "#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; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none" >&5
printf "%s\n" "none" >&6; }
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5
$as_echo "${tcl_flags}" >&6; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5
printf "%s\n" "${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
    { 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 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 ()
main (void)
{
switch (0) {
            case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ;
            case 1: case (sizeof(long long)==sizeof(long)): ;
        }
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_cv_type_64bit=${tcl_type_64bit}
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_type_64bit="long long"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

    if test "${tcl_cv_type_64bit}" = none ; then

$as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h
printf "%s\n" "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "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
	{ 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 ()
main (void)
{
struct dirent64 p;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_struct_dirent64=yes
else
else $as_nop
  tcl_cv_struct_dirent64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5
$as_echo "$tcl_cv_struct_dirent64" >&6; }
{ 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

$as_echo "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h
printf "%s\n" "#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
	{ 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_DIR64=yes
else
else $as_nop
  tcl_cv_DIR64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_DIR64" >&5
$as_echo "$tcl_cv_DIR64" >&6; }
{ 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

$as_echo "#define HAVE_DIR64 1" >>confdefs.h
printf "%s\n" "#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
	{ 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 ()
main (void)
{
struct stat64 p;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_struct_stat64=yes
else
else $as_nop
  tcl_cv_struct_stat64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_stat64" >&5
$as_echo "$tcl_cv_struct_stat64" >&6; }
{ 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

$as_echo "#define HAVE_STRUCT_STAT64 1" >>confdefs.h
printf "%s\n" "#define HAVE_STRUCT_STAT64 1" >>confdefs.h

	fi

	ac_fn_c_check_func "$LINENO" "open64" "ac_cv_func_open64"
	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
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
#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
	{ 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 ()
main (void)
{
off64_t offset;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_type_off64_t=yes
else
else $as_nop
  tcl_cv_type_off64_t=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
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

$as_echo "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h
printf "%s\n" "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h

	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
	    { 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.
#--------------------------------------------------------------------

 { $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
 { 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 :
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

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.$ac_ext
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 ()
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 :
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 ()
main (void)
{
#if BYTE_ORDER != BIG_ENDIAN
		 not big endian
		#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_c_bigendian=yes
else
else $as_nop
  ac_cv_c_bigendian=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
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 ()
main (void)
{
#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN)
	      bogus endian macros
	     #endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
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 ()
main (void)
{
#ifndef _BIG_ENDIAN
		 not big endian
		#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_c_bigendian=yes
else
else $as_nop
  ac_cv_c_bigendian=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
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 :
      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[] =
unsigned short int ascii_mm[] =
		  { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
		short int ascii_ii[] =
		unsigned 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[] =
		unsigned short int ebcdic_ii[] =
		  { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
		short int ebcdic_mm[] =
		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 ()
main (void)
{
return use_ascii (foo) == use_ebcdic (foo);
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
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
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 ()
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 :
if ac_fn_c_try_run "$LINENO"
then :
  ac_cv_c_bigendian=no
else
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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
$as_echo "$ac_cv_c_bigendian" >&6; }
{ 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)
     $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h
     printf "%s\n" "#define WORDS_BIGENDIAN 1" >>confdefs.h
;; #(
   no)
      ;; #(
   universal)

$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h
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
  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 :
if test "x$ac_cv_func_getcwd" = xyes
  cat >>confdefs.h <<_ACEOF
#define HAVE_GETCWD 1
then :
  printf "%s\n" "#define HAVE_GETCWD 1" >>confdefs.h
_ACEOF

else
else $as_nop

$as_echo "#define USEGETWD 1" >>confdefs.h
printf "%s\n" "#define USEGETWD 1" >>confdefs.h

fi
done

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
if test "x$ac_cv_func_mkstemp" = xyes
then :
  printf "%s\n" "#define HAVE_MKSTEMP 1" >>confdefs.h

else
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 :
  $as_echo "#define HAVE_OPENDIR 1" >>confdefs.h
if test "x$ac_cv_func_opendir" = xyes
then :
  printf "%s\n" "#define HAVE_OPENDIR 1" >>confdefs.h

else
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 :
  $as_echo "#define HAVE_STRTOL 1" >>confdefs.h
if test "x$ac_cv_func_strtol" = xyes
then :
  printf "%s\n" "#define HAVE_STRTOL 1" >>confdefs.h

else
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 :
  $as_echo "#define HAVE_WAITPID 1" >>confdefs.h
if test "x$ac_cv_func_waitpid" = xyes
then :
  printf "%s\n" "#define HAVE_WAITPID 1" >>confdefs.h

else
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 :
if test "x$ac_cv_func_strerror" = xyes
then :

else
else $as_nop

$as_echo "#define NO_STRERROR 1" >>confdefs.h
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 :
if test "x$ac_cv_func_getwd" = xyes
then :

else
else $as_nop

$as_echo "#define NO_GETWD 1" >>confdefs.h
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 :
if test "x$ac_cv_func_wait3" = xyes
then :

else
else $as_nop

$as_echo "#define NO_WAIT3 1" >>confdefs.h
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 :
if test "x$ac_cv_func_uname" = xyes
then :

else
else $as_nop

$as_echo "#define NO_UNAME 1" >>confdefs.h
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 :
if test "x$ac_cv_func_realpath" = xyes
then :

else
else $as_nop

$as_echo "#define NO_REALPATH 1" >>confdefs.h
printf "%s\n" "#define NO_REALPATH 1" >>confdefs.h

fi



	NEED_FAKE_RFC2553=0

	for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror
  for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror
do :
  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
  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 :
if eval test \"x\$"$as_ac_var"\" = x"yes"
then :
  cat >>confdefs.h <<_ACEOF
#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
#define `printf "%s\n" "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF

else
else $as_nop
  NEED_FAKE_RFC2553=1
fi
done

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 :
if test "x$ac_cv_type_struct_addrinfo" = xyes
then :

cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_ADDRINFO 1
printf "%s\n" "#define HAVE_STRUCT_ADDRINFO 1" >>confdefs.h
_ACEOF


else
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 :
if test "x$ac_cv_type_struct_in6_addr" = xyes
then :

cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_IN6_ADDR 1
printf "%s\n" "#define HAVE_STRUCT_IN6_ADDR 1" >>confdefs.h
_ACEOF


else
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 :
if test "x$ac_cv_type_struct_sockaddr_in6" = xyes
then :

cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_SOCKADDR_IN6 1
printf "%s\n" "#define HAVE_STRUCT_SOCKADDR_IN6 1" >>confdefs.h
_ACEOF


else
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 :
if test "x$ac_cv_type_struct_sockaddr_storage" = xyes
then :

cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_SOCKADDR_STORAGE 1
printf "%s\n" "#define HAVE_STRUCT_SOCKADDR_STORAGE 1" >>confdefs.h
_ACEOF


else
else $as_nop
  NEED_FAKE_RFC2553=1
fi

if test "x$NEED_FAKE_RFC2553" = "x1"; then

$as_echo "#define NEED_FAKE_RFC2553 1" >>confdefs.h
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 :
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 :
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
    { 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_getpwuid_r_5=yes
else
else $as_nop
  tcl_cv_api_getpwuid_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETPWUID_R_5 1" >>confdefs.h
printf "%s\n" "#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
	{ 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_getpwuid_r_4=yes
else
else $as_nop
  tcl_cv_api_getpwuid_r_4=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETPWUID_R_4 1" >>confdefs.h
printf "%s\n" "#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
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 :
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
    { 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_getpwnam_r_5=yes
else
else $as_nop
  tcl_cv_api_getpwnam_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETPWNAM_R_5 1" >>confdefs.h
printf "%s\n" "#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
	{ 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_getpwnam_r_4=yes
else
else $as_nop
  tcl_cv_api_getpwnam_r_4=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETPWNAM_R_4 1" >>confdefs.h
printf "%s\n" "#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
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 :
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
    { 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_getgrgid_r_5=yes
else
else $as_nop
  tcl_cv_api_getgrgid_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETGRGID_R_5 1" >>confdefs.h
printf "%s\n" "#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
	{ 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_getgrgid_r_4=yes
else
else $as_nop
  tcl_cv_api_getgrgid_r_4=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETGRGID_R_4 1" >>confdefs.h
printf "%s\n" "#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
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 :
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
    { 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_getgrnam_r_5=yes
else
else $as_nop
  tcl_cv_api_getgrnam_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETGRNAM_R_5 1" >>confdefs.h
printf "%s\n" "#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
	{ 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_getgrnam_r_4=yes
else
else $as_nop
  tcl_cv_api_getgrnam_r_4=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETGRNAM_R_4 1" >>confdefs.h
printf "%s\n" "#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
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.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h
printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 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.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h
printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 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 :
if test "x$ac_cv_have_decl_gethostbyname_r" = xyes
then :
  ac_have_decl=1
else
else $as_nop
  ac_have_decl=0
fi

cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_GETHOSTBYNAME_R $ac_have_decl
printf "%s\n" "#define HAVE_DECL_GETHOSTBYNAME_R $ac_have_decl" >>confdefs.h
_ACEOF
if test $ac_have_decl = 1; then :
if test $ac_have_decl = 1
then :

    tcl_cv_api_gethostbyname_r=yes
else
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 :
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
    { 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_gethostbyname_r_6=yes
else
else $as_nop
  tcl_cv_api_gethostbyname_r_6=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETHOSTBYNAME_R_6 1" >>confdefs.h
printf "%s\n" "#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
	{ 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_gethostbyname_r_5=yes
else
else $as_nop
  tcl_cv_api_gethostbyname_r_5=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETHOSTBYNAME_R_5 1" >>confdefs.h
printf "%s\n" "#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
	    { 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_gethostbyname_r_3=yes
else
else $as_nop
  tcl_cv_api_gethostbyname_r_3=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETHOSTBYNAME_R_3 1" >>confdefs.h
printf "%s\n" "#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
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 :
if test "x$ac_cv_have_decl_gethostbyaddr_r" = xyes
then :
  ac_have_decl=1
else
else $as_nop
  ac_have_decl=0
fi

cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_GETHOSTBYADDR_R $ac_have_decl
printf "%s\n" "#define HAVE_DECL_GETHOSTBYADDR_R $ac_have_decl" >>confdefs.h
_ACEOF
if test $ac_have_decl = 1; then :
if test $ac_have_decl = 1
then :

    tcl_cv_api_gethostbyaddr_r=yes
else
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 :
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
    { 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_gethostbyaddr_r_7=yes
else
else $as_nop
  tcl_cv_api_gethostbyaddr_r_7=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETHOSTBYADDR_R_7 1" >>confdefs.h
printf "%s\n" "#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
	{ 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_api_gethostbyaddr_r_8=yes
else
else $as_nop
  tcl_cv_api_gethostbyaddr_r_8=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_GETHOSTBYADDR_R_8 1" >>confdefs.h
printf "%s\n" "#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
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.
#---------------------------------------------------------------------------

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 :
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
  cat >>confdefs.h <<_ACEOF
#define HAVE_TERMIOS_H 1
then :
  printf "%s\n" "#define HAVE_TERMIOS_H 1" >>confdefs.h
_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 :
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
  cat >>confdefs.h <<_ACEOF
#define HAVE_SYS_IOCTL_H 1
then :
  printf "%s\n" "#define HAVE_SYS_IOCTL_H 1" >>confdefs.h
_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 :
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
  cat >>confdefs.h <<_ACEOF
#define HAVE_SYS_MODEM_H 1
then :
  printf "%s\n" "#define HAVE_SYS_MODEM_H 1" >>confdefs.h
_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
{ 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 ()
main (void)
{
fd_set readMask, writeMask;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_type_fd_set=yes
else
else $as_nop
  tcl_cv_type_fd_set=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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
    { $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
    { 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 :
  $EGREP "fd_mask" >/dev/null 2>&1
then :
  tcl_cv_grep_fd_mask=present
else
else $as_nop
  tcl_cv_grep_fd_mask=missing
fi
rm -f conftest*
rm -rf conftest*

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_fd_mask" >&5
$as_echo "$tcl_cv_grep_fd_mask" >&6; }
{ 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

$as_echo "#define HAVE_SYS_SELECT_H 1" >>confdefs.h
printf "%s\n" "#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
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
#------------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for advanced notifier support" >&5
$as_echo_n "checking for advanced notifier support... " >&6; }
{ 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)
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: epoll(7)" >&5
$as_echo "epoll(7)" >&6; }
	for ac_header in sys/epoll.h
	{ 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_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
  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
_ACEOF

$as_echo "#define NOTIFIER_EPOLL 1" >>confdefs.h
printf "%s\n" "#define NOTIFIER_EPOLL 1" >>confdefs.h

fi

done

	for ac_header in sys/eventfd.h
	       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 :
  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
  cat >>confdefs.h <<_ACEOF
#define HAVE_SYS_EVENTFD_H 1
then :
  printf "%s\n" "#define HAVE_SYS_EVENTFD_H 1" >>confdefs.h
_ACEOF

$as_echo "#define HAVE_EVENTFD 1" >>confdefs.h
printf "%s\n" "#define HAVE_EVENTFD 1" >>confdefs.h

fi

done
done;;
;;
  xDragonFlyBSD|xFreeBSD|xNetBSD|xOpenBSD)
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: kqueue(2)" >&5
$as_echo "kqueue(2)" >&6; }
	{ 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
	       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 :
  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 `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
#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 :
	if test $tcl_kqueue_headers = xyyy
then :


$as_echo "#define NOTIFIER_KQUEUE 1" >>confdefs.h
printf "%s\n" "#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; };;
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: OSX" >&5
printf "%s\n" "OSX" >&6; };;
  *)
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
$as_echo "none" >&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.
#------------------------------------------------------------------------------


    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 :
    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
  cat >>confdefs.h <<_ACEOF
#define HAVE_SYS_TIME_H 1
then :
  printf "%s\n" "#define HAVE_SYS_TIME_H 1" >>confdefs.h
_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 :
    ac_fn_c_check_func "$LINENO" "gmtime_r" "ac_cv_func_gmtime_r"
if test "x$ac_cv_func_gmtime_r" = xyes
  $as_echo_n "(cached) " >&6
else
then :
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
  printf "%s\n" "#define HAVE_GMTIME_R 1" >>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 :
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 :
  ac_cv_header_time=yes
else
  ac_cv_header_time=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
  printf %s "(cached) " >&6
else $as_nop

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <time.h>
int
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_time" >&5
$as_echo "$ac_cv_header_time" >&6; }
main (void)
if test $ac_cv_header_time = yes; then

{
$as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h

struct tm tm; (void)tm.tm_tzadj;
fi


  ;
  return 0;
}
    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

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
done

printf "%s\n" "#define HAVE_TM_TZADJ 1" >>confdefs.h

    fi

    { $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
    { 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 ()
main (void)
{
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_member_tm_gmtoff=yes
else
else $as_nop
  tcl_cv_member_tm_gmtoff=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h
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.
    #
    { $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
    { 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 ()
main (void)
{
extern long timezone;
	    timezone += 1;
	    exit (0);
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_timezone_long=yes
else
else $as_nop
  tcl_cv_timezone_long=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_long" >&5
$as_echo "$tcl_cv_timezone_long" >&6; }
{ 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

$as_echo "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h
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.
	#
	{ $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
	{ 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 ()
main (void)
{
extern time_t timezone;
		timezone += 1;
		exit (0);
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_timezone_time=yes
else
else $as_nop
  tcl_cv_timezone_time=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_time" >&5
$as_echo "$tcl_cv_timezone_time" >&6; }
{ 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

$as_echo "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h
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 :
if test "x$ac_cv_member_struct_stat_st_blocks" = xyes
then :

cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_STAT_ST_BLOCKS 1
printf "%s\n" "#define HAVE_STRUCT_STAT_ST_BLOCKS 1" >>confdefs.h
_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 :
if test "x$ac_cv_member_struct_stat_st_blksize" = xyes
then :

cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_STAT_ST_BLKSIZE 1
printf "%s\n" "#define HAVE_STRUCT_STAT_ST_BLKSIZE 1" >>confdefs.h
_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 :
if test "x$ac_cv_type_blkcnt_t" = xyes
then :

cat >>confdefs.h <<_ACEOF
#define HAVE_BLKCNT_T 1
printf "%s\n" "#define HAVE_BLKCNT_T 1" >>confdefs.h
_ACEOF


fi

ac_fn_c_check_func "$LINENO" "fstatfs" "ac_cv_func_fstatfs"
if test "x$ac_cv_func_fstatfs" = xyes; then :
if test "x$ac_cv_func_fstatfs" = xyes
then :

else
else $as_nop

$as_echo "#define NO_FSTATFS 1" >>confdefs.h
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
#--------------------------------------------------------------------

{ $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 :
{ 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
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main ()
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

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 :
if ac_fn_c_try_run "$LINENO"
then :
  ac_cv_func_memcmp_working=yes
else
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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_memcmp_working" >&5
$as_echo "$ac_cv_func_memcmp_working" >&6; }
{ 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 :
if test "x$ac_cv_func_memmove" = xyes
then :

else
else $as_nop


$as_echo "#define NO_MEMMOVE 1" >>confdefs.h
printf "%s\n" "#define NO_MEMMOVE 1" >>confdefs.h


$as_echo "#define NO_STRING_H 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 :
if test "x$ac_cv_func_strstr" = xyes
then :
  tcl_ok=1
else
else $as_nop
  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 :
	{ 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
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 :
if ac_fn_c_try_run "$LINENO"
then :
  tcl_cv_strstr_unbroken=ok
else
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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strstr_unbroken" >&5
$as_echo "$tcl_cv_strstr_unbroken" >&6; }
{ 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

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 :
if test "x$ac_cv_func_strtoul" = xyes
then :
  tcl_ok=1
else
else $as_nop
  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 :
	{ 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
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 :
if ac_fn_c_try_run "$LINENO"
then :
  tcl_cv_strtoul_unbroken=ok
else
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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtoul_unbroken" >&5
$as_echo "$tcl_cv_strtoul_unbroken" >&6; }
{ 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

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 :
if test "x$ac_cv_type_mode_t" = xyes
then :

else
else $as_nop

cat >>confdefs.h <<_ACEOF
#define mode_t int
printf "%s\n" "#define mode_t int" >>confdefs.h
_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 :
  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
else $as_nop
                                          cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

          #if defined _WIN64 && !defined __CYGWIN__
          LLP64
          #endif
cat >>confdefs.h <<_ACEOF
#define pid_t int

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 :
if test "x$ac_cv_type_size_t" = xyes
then :

else
else $as_nop

cat >>confdefs.h <<_ACEOF
#define size_t unsigned int
printf "%s\n" "#define size_t unsigned int" >>confdefs.h
_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
{ 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 :
  $EGREP "uid_t" >/dev/null 2>&1
then :
  ac_cv_type_uid_t=yes
else
else $as_nop
  ac_cv_type_uid_t=no
fi
rm -f conftest*
rm -rf conftest*

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_uid_t" >&5
$as_echo "$ac_cv_type_uid_t" >&6; }
{ 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

$as_echo "#define uid_t int" >>confdefs.h
printf "%s\n" "#define uid_t int" >>confdefs.h


$as_echo "#define gid_t int" >>confdefs.h
printf "%s\n" "#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
{ 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 ()
main (void)
{

    	socklen_t foo;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_type_socklen_t=yes
else
else $as_nop
  tcl_cv_type_socklen_t=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define socklen_t int" >>confdefs.h
printf "%s\n" "#define socklen_t int" >>confdefs.h

fi

ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default"
ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "
if test "x$ac_cv_type_intptr_t" = xyes; then :

#include <stdint.h>

$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h

"
else

if test "x$ac_cv_type_intptr_t" = xyes
    { $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

then :
    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
printf "%s\n" "#define HAVE_INTPTR_T 1" >>confdefs.h
#define intptr_t $tcl_cv_intptr_t
_ACEOF

    fi

fi

fi
ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default"
ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "
if test "x$ac_cv_type_uintptr_t" = xyes; then :

#include <stdint.h>

$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h

"
else

if test "x$ac_cv_type_uintptr_t" = xyes
    { $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

then :
    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];

  ;
printf "%s\n" "#define HAVE_UINTPTR_T 1" >>confdefs.h

  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 :
if test "x$ac_cv_func_opendir" = xyes
then :

else
else $as_nop

$as_echo "#define USE_DIRENT2_H 1" >>confdefs.h
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.
#--------------------------------------------------------------------

{ $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
{ 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 ()
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 :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_union_wait=yes
else
else $as_nop
  tcl_cv_union_wait=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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; }
{ 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

$as_echo "#define NO_UNION_WAIT 1" >>confdefs.h
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 :
if test "x$ac_cv_func_strncasecmp" = xyes
then :
  tcl_ok=1
else
else $as_nop
  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
    { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char strncasecmp ();
int
main ()
main (void)
{
return strncasecmp ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_socket_strncasecmp=yes
else
else $as_nop
  ac_cv_lib_socket_strncasecmp=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
else $as_nop
  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
    { 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.  */
#ifdef __cplusplus
extern "C"
#endif
char strncasecmp ();
int
main ()
main (void)
{
return strncasecmp ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_lib_inet_strncasecmp=yes
else
else $as_nop
  ac_cv_lib_inet_strncasecmp=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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 :
{ 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
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

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 :
if test "x$ac_cv_func_gettimeofday" = xyes
then :

else
else $as_nop


$as_echo "#define NO_GETTOD 1" >>confdefs.h
printf "%s\n" "#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
{ 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 :
  $EGREP "gettimeofday" >/dev/null 2>&1
then :
  tcl_cv_grep_gettimeofday=present
else
else $as_nop
  tcl_cv_grep_gettimeofday=missing
fi
rm -f conftest*
rm -rf conftest*

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_gettimeofday" >&5
$as_echo "$tcl_cv_grep_gettimeofday" >&6; }
{ 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

$as_echo "#define GETTOD_NOT_DECLARED 1" >>confdefs.h
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.
#--------------------------------------------------------------------

{ $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
{ 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_c_char_unsigned=no
else
else $as_nop
  ac_cv_c_char_unsigned=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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
{ 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

{ $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
{ 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 ()
main (void)
{

	signed char *p;
	p = 0;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_char_signed=yes
else
else $as_nop
  tcl_cv_char_signed=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_char_signed" >&5
$as_echo "$tcl_cv_char_signed" >&6; }
{ 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

$as_echo "#define HAVE_SIGNED_CHAR 1" >>confdefs.h
printf "%s\n" "#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
{ 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 :
    if test "$cross_compiling" = yes
then :
  tcl_cv_putenv_copy=no
else
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

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 :
if ac_fn_c_try_run "$LINENO"
then :
  tcl_cv_putenv_copy=no
else
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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_putenv_copy" >&5
$as_echo "$tcl_cv_putenv_copy" >&6; }
{ 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

$as_echo "#define HAVE_PUTENV_THAT_COPIES 1" >>confdefs.h
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+set}" = set; then :
if test ${enable_langinfo+y}
then :
  enableval=$enable_langinfo; langinfo_ok=$enableval
else
else $as_nop
  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 :
	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
else $as_nop
  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; }
    { 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 ${tcl_cv_langinfo_h+:} false; then :
  $as_echo_n "(cached) " >&6
else
	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 ()
main (void)
{
nl_langinfo(CODESET);
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_langinfo_h=yes
else
else $as_nop
  tcl_cv_langinfo_h=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_langinfo_h" >&5
$as_echo "$tcl_cv_langinfo_h" >&6; }
	{ 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

$as_echo "#define HAVE_LANGINFO 1" >>confdefs.h
printf "%s\n" "#define HAVE_LANGINFO 1" >>confdefs.h

	fi
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $langinfo_ok" >&5
$as_echo "$langinfo_ok" >&6; }
	{ 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"
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
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
#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF

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
done

fi


#--------------------------------------------------------------------
# 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
{ 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 ()
main (void)
{

isnan(0.0);			/* Generates an error if isnan is missing */

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_isnan=yes
else
else $as_nop
  tcl_cv_isnan=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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; }
{ 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

$as_echo "#define NO_ISNAN 1" >>confdefs.h
printf "%s\n" "#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 :
    ac_fn_c_check_func "$LINENO" "getattrlist" "ac_cv_func_getattrlist"
if test "x$ac_cv_func_getattrlist" = xyes
  cat >>confdefs.h <<_ACEOF
#define HAVE_GETATTRLIST 1
then :
  printf "%s\n" "#define HAVE_GETATTRLIST 1" >>confdefs.h
_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 :
    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
  cat >>confdefs.h <<_ACEOF
#define HAVE_COPYFILE_H 1
then :
  printf "%s\n" "#define HAVE_COPYFILE_H 1" >>confdefs.h
_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 :
    ac_fn_c_check_func "$LINENO" "copyfile" "ac_cv_func_copyfile"
if test "x$ac_cv_func_copyfile" = xyes
  cat >>confdefs.h <<_ACEOF
#define HAVE_COPYFILE 1
then :
  printf "%s\n" "#define HAVE_COPYFILE 1" >>confdefs.h
_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 :
	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
  cat >>confdefs.h <<_ACEOF
#define HAVE_LIBKERN_OSATOMIC_H 1
then :
  printf "%s\n" "#define HAVE_LIBKERN_OSATOMIC_H 1" >>confdefs.h
_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 :
	ac_fn_c_check_func "$LINENO" "OSSpinLockLock" "ac_cv_func_OSSpinLockLock"
if test "x$ac_cv_func_OSSpinLockLock" = xyes
  cat >>confdefs.h <<_ACEOF
#define HAVE_OSSPINLOCKLOCK 1
then :
  printf "%s\n" "#define HAVE_OSSPINLOCKLOCK 1" >>confdefs.h
_ACEOF

fi
done

    fi

    fi

$as_echo "#define USE_VFORK 1" >>confdefs.h
printf "%s\n" "#define USE_VFORK 1" >>confdefs.h


$as_echo "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h
printf "%s\n" "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h


$as_echo "#define TCL_WIDE_CLICKS 1" >>confdefs.h
printf "%s\n" "#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 :
    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
  cat >>confdefs.h <<_ACEOF
#define HAVE_AVAILABILITYMACROS_H 1
then :
  printf "%s\n" "#define HAVE_AVAILABILITYMACROS_H 1" >>confdefs.h
_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
	{ 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 ()
main (void)
{
rand();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_cc_weak_import=yes
else
else $as_nop
  tcl_cv_cc_weak_import=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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; }
{ 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

$as_echo "#define HAVE_WEAK_IMPORT 1" >>confdefs.h
printf "%s\n" "#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
	{ 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_cc_darwin_c_source=yes
else
else $as_nop
  tcl_cv_cc_darwin_c_source=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define _DARWIN_C_SOURCE 1" >>confdefs.h
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)
#--------------------------------------------------------------------

{ $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
{ 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 ()
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 :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_api_fts=yes
else
else $as_nop
  tcl_cv_api_fts=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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; }
{ 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

$as_echo "#define HAVE_FTS 1" >>confdefs.h
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.
#--------------------------------------------------------------------


    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 :
    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
  cat >>confdefs.h <<_ACEOF
#define HAVE_SYS_IOCTL_H 1
then :
  printf "%s\n" "#define HAVE_SYS_IOCTL_H 1" >>confdefs.h
_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 :
    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
  cat >>confdefs.h <<_ACEOF
#define HAVE_SYS_FILIO_H 1
then :
  printf "%s\n" "#define HAVE_SYS_FILIO_H 1" >>confdefs.h
_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
    { 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
		{ $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;}
		{ 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5
$as_echo "$tcl_cv_sys_version" >&6; }
{ 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

    { $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; }
    { 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*)

$as_echo "#define USE_FIONBIO 1" >>confdefs.h
printf "%s\n" "#define USE_FIONBIO 1" >>confdefs.h

	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5
$as_echo "FIONBIO" >&6; }
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5
printf "%s\n" "FIONBIO" >&6; }
	    ;;
	*)
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5
$as_echo "O_NONBLOCK" >&6; }
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5
printf "%s\n" "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; }
{ 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+set}" = set; then :
if test ${enable_dll_unloading+y}
then :
  enableval=$enable_dll_unloading; tcl_ok=$enableval
else
else $as_nop
  tcl_ok=yes
fi

if test $tcl_ok = yes; then

$as_echo "#define TCL_UNLOAD_DLLS 1" >>confdefs.h
printf "%s\n" "#define TCL_UNLOAD_DLLS 1" >>confdefs.h

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
$as_echo "$tcl_ok" >&6; }
{ 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.
#------------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for timezone data" >&5
$as_echo_n "checking for timezone data... " >&6; }
{ 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+set}" = set; then :
if test ${with_tzdata+y}
then :
  withval=$with_tzdata; tcl_ok=$withval
else
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)
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by OS vendor" >&5
$as_echo "supplied by OS vendor" >&6; }
	{ 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 ${tcl_cv_dir_zoneinfo+:} false; then :
  $as_echo_n "(cached) " >&6
else
	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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $dir" >&5
$as_echo "$dir" >&6; }
	    { 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
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by Tcl" >&5
$as_echo "supplied by Tcl" >&6; }
    { 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+set}" = set; then :
if test ${enable_dtrace+y}
then :
  enableval=$enable_dtrace; tcl_ok=$enableval
else
else $as_nop
  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 :
    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
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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
  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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DTRACE" >&5
$as_echo "$DTRACE" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $DTRACE" >&5
printf "%s\n" "$DTRACE" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable DTrace support" >&5
$as_echo_n "checking whether to enable DTrace support... " >&6; }
{ 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

$as_echo "#define USE_DTRACE 1" >>confdefs.h
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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
$as_echo "$tcl_ok" >&6; }
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
printf "%s\n" "$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
{ 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 ()
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 :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_cpuid=yes
else
else $as_nop
  tcl_cv_cpuid=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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; }
{ 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

$as_echo "#define HAVE_CPUID 1" >>confdefs.h
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

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
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to package libraries" >&5
$as_echo_n "checking how to package libraries... " >&6; }
	{ 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+set}" = set; then :
if test ${enable_framework+y}
then :
  enableval=$enable_framework; enable_framework=$enableval
else
else $as_nop
  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;}
		{ 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
		{ $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;}
		{ 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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: framework" >&5
$as_echo "framework" >&6; }
	    { 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
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result: shared library" >&5
$as_echo "shared library" >&6; }
		{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared library" >&5
printf "%s\n" "shared library" >&6; }
	    else
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static library" >&5
$as_echo "static library" >&6; }
		{ 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

$as_echo "#define TCL_FRAMEWORK 1" >>confdefs.h
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

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

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

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_*) { $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;} ;;
      *_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

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+set}" = set || &/
     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
      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
$as_echo "$as_me: updating cache $cache_file" >&6;}
      { 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
    { $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;}
    { 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

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"
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
{ 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

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 -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
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
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
# 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 --'
IFS=" ""	$as_nl"

elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
PS1='$ '
PS2='> '
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
PS4='+ '
      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

# Ensure predictable behavior from utilities with locale-dependent output.
LC_ALL=C
export LC_ALL
    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
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 test "${PATH_SEPARATOR+set}" != set; then
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


# 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
  case $as_dir in #(((
  test -z "$as_dir" && as_dir=.
    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
    '') 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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  printf "%s\n" "$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
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  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

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 :
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
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 :
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null
then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else
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

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 ||
$as_echo X/"$0" |
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

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

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=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *\'*) 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 ||
$as_echo X"$as_dir" |
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

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.69.  Invocation command line 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

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="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_config='$ac_cs_config_escaped'
ac_cs_version="\\
tcl config.status 9.0
configured by $0, generated by GNU Autoconf 2.69,
configured by $0, generated by GNU Autoconf 2.70,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 Free Software Foundation, Inc.
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

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 )
    $as_echo "$ac_cs_version"; exit ;;
    printf "%s\n" "$ac_cs_version"; exit ;;
  --config | --confi | --conf | --con | --co | --c )
    $as_echo "$ac_cs_config"; exit ;;
    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=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
    *\'*) 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 )
    $as_echo "$ac_cs_usage"; exit ;;
    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

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
  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
  \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
  $as_echo "$ac_log"
  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

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+set}" = set || CONFIG_FILES=$config_files
  test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands
  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

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=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; 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 '`
	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
	  printf "%s\n" "$*" | 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;}
      { 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=`$as_echo "$configure_input" |
       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 ||
$as_echo X"$ac_file" |
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

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=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  ac_dir_suffix=/`printf "%s\n" "$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|/||'`
  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

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@*)
  { $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;}
  { 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

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"; } &&
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
  { 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
$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
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)  { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5
$as_echo "$as_me: executing $ac_file commands" >&6;}
  :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


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
  { $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;}
  { 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

1
2
3
4
5
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)
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
    /* 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

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_TRY_COMPILE(,, tcl_cv_cc_pipe=yes, tcl_cv_cc_pipe=no)
	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

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,
AC_HELP_STRING([--with-system-libtommath],
AS_HELP_STRING([--with-system-libtommath],
	[use external libtommath (default: true if available, false otherwise)]),
	libtommath_ok=${withval})
	[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

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_TRY_COMPILE([#include <sys/types.h>],[fd_set readMask, writeMask;],
	tcl_cv_type_fd_set=yes, tcl_cv_type_fd_set=no)])
    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

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_TRY_COMPILE([
    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])])
    ]])],[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_CHECK_TYPES([intptr_t, uintptr_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], [
#include <stdint.h>
    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>], [
    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)])
    ]])],[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

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_TRY_COMPILE(, [
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[
	signed char *p;
	p = 0;
	], tcl_cv_char_signed=yes, tcl_cv_char_signed=no)])
	]])],[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([
    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)])
    ]])],
    [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

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_TRY_LINK([#include <math.h>], [
    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)])
]])],[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

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_TRY_LINK([
	    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)
		]], [[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([
	    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)
		]], [[]])],[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([
    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)])
	]])],[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],
    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,
    AC_HELP_STRING([--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

720
721
722
723
724
725
726

727
728
729
730
731
732
733
734








-
+








fi

#--------------------------------------------------------------------
#	DTrace support
#--------------------------------------------------------------------

AC_ARG_ENABLE(dtrace,
    AC_HELP_STRING([--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

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])

#--------------------------------------------------------------------
#	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(, [
    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)])
    ]])],[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

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

21
22
23
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: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX}
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: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX}
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

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}

pkga${SHLIB_SUFFIX}: pkga.o
	${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS}
tcl9pkga${SHLIB_SUFFIX}: pkga.o
	${SHLIB_LD} -o $@ pkga.o ${SHLIB_LD_LIBS}

pkgb${SHLIB_SUFFIX}: pkgb.o
	${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o ${SHLIB_LD_LIBS}
tcl9pkgb${SHLIB_SUFFIX}: pkgb.o
	${SHLIB_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS}

pkgc${SHLIB_SUFFIX}: pkgc.o
	${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o ${SHLIB_LD_LIBS}
tcl9pkgc${SHLIB_SUFFIX}: pkgc.o
	${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}

pkgd${SHLIB_SUFFIX}: pkgd.o
	${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${SHLIB_LD_LIBS}
tcl9pkgd${SHLIB_SUFFIX}: pkgd.o
	${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

pkge${SHLIB_SUFFIX}: pkge.o
	${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${SHLIB_LD_LIBS}
tcl9pkge${SHLIB_SUFFIX}: pkge.o
	${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

pkgua${SHLIB_SUFFIX}: pkgua.o
	${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}
tcl9pkgua${SHLIB_SUFFIX}: pkgua.o
	${SHLIB_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS}

pkgooa${SHLIB_SUFFIX}: pkgooa.o
	${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.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}

pkga${DLTEST_SUFFIX}: pkga.o
	${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS}
tcl9pkga${DLTEST_SUFFIX}: pkga.o
	${DLTEST_LD} -o $@ pkga.o ${SHLIB_LD_LIBS}

pkgb${DLTEST_SUFFIX}: pkgb.o
	${DLTEST_LD} -o pkgb${DLTEST_SUFFIX} pkgb.o ${SHLIB_LD_LIBS}
tcl9pkgb${DLTEST_SUFFIX}: pkgb.o
	${DLTEST_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS}

pkgc${DLTEST_SUFFIX}: pkgc.o
	${DLTEST_LD} -o pkgc${DLTEST_SUFFIX} pkgc.o ${SHLIB_LD_LIBS}
tcl9pkgc${DLTEST_SUFFIX}: pkgc.o
	${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}

pkgd${DLTEST_SUFFIX}: pkgd.o
	${DLTEST_LD} -o pkgd${DLTEST_SUFFIX} pkgd.o ${SHLIB_LD_LIBS}
tcl9pkgd${DLTEST_SUFFIX}: pkgd.o
	${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

pkge${DLTEST_SUFFIX}: pkge.o
	${DLTEST_LD} -o pkge${DLTEST_SUFFIX} pkge.o ${SHLIB_LD_LIBS}
tcl9pkge${DLTEST_SUFFIX}: pkge.o
	${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

pkgua${DLTEST_SUFFIX}: pkgua.o
	${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}
tcl9pkgua${DLTEST_SUFFIX}: pkgua.o
	${DLTEST_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS}

pkgooa${DLTEST_SUFFIX}: pkgooa.o
	${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS}
tcl9pkgooa${DLTEST_SUFFIX}: pkgooa.o
	${DLTEST_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS}

clean:
	rm -f *.o lib.exp ../dltest.marker
	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

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.
 * 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

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");
    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

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
 *	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.
 * 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

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");
    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

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");
    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

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.
 * 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

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");
    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

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");
    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

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
 *	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.
 * 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

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");
    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

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");
    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

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.
 * 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

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.
 * 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

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");
    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

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
 * 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

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");
    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

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"
	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

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],
	    AS_HELP_STRING([--with-tcl],
		[directory containing tcl configuration (tclConfig.sh)]),
	    with_tclconfig="${withval}")
	    [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

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],
	    AS_HELP_STRING([--with-tk],
		[directory containing tk configuration (tkConfig.sh)]),
	    with_tkconfig="${withval}")
	    [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

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,
	AC_HELP_STRING([--enable-shared],
	AS_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?])




︙


547
548
549
550
551
552
553
554

555
556
557
558
559
560
561

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,
	    AC_HELP_STRING([--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

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,
	AC_HELP_STRING([--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

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,
	AC_HELP_STRING([--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_TRY_COMPILE([#include <langinfo.h>], [nl_langinfo(CODESET);],
		    [tcl_cv_langinfo_h=yes],[tcl_cv_langinfo_h=no])])
	    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

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,
	AC_HELP_STRING([--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")
	[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],
	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")
	[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],
	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")
	[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

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,
	AC_HELP_STRING([--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,
	AC_HELP_STRING([--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_TRY_LINK([
	AC_LINK_IFELSE([AC_LANG_PROGRAM([[
	    extern __attribute__((__visibility__("hidden"))) void f(void);
	    void f(void) {}]], [[f();]])],
	    void f(void) {}], [f();], tcl_cv_cc_visibility_hidden=yes,
	    tcl_cv_cc_visibility_hidden=no)
	    [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],
	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

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 -Wdeclaration-after-statement"
		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

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_*)
	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_TRY_COMPILE([
		AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		#ifdef __CYGWIN__
		    #error cygwin
		#endif
		], [],
		ac_cv_cygwin=no,
		ac_cv_cygwin=yes)
		]], [[]])],
		[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

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_TRY_LINK(,, tcl_cv_cc_m64=yes, tcl_cv_cc_m64=no)
		    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

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([[]], [[]])],
			    AC_TRY_LINK(,, tcl_cv_cc_arch_ppc64=yes,
				    tcl_cv_cc_arch_ppc64=no)
				    [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([[]], [[]])],
			    AC_TRY_LINK(,, tcl_cv_cc_arch_x86_64=yes,
				    tcl_cv_cc_arch_x86_64=no)
				    [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],
		AC_TRY_LINK(, [int i;], tcl_cv_ld_single_module=yes, tcl_cv_ld_single_module=no)
		    [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;]])],
		AC_TRY_LINK(, [int i;], tcl_cv_ld_search_paths_first=yes,
			tcl_cv_ld_search_paths_first=no)
			[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],
		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_TRY_LINK([#include <CoreFoundation/CoreFoundation.h>],
			[CFBundleRef b = CFBundleGetMainBundle();],
			tcl_cv_lib_corefoundation=yes,
			tcl_cv_lib_corefoundation=no)
		    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_TRY_LINK([#include <CoreFoundation/CoreFoundation.h>],
			    [CFBundleRef b = CFBundleGetMainBundle();],
			    tcl_cv_lib_corefoundation_64=yes,
			    tcl_cv_lib_corefoundation_64=no)
			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

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_TRY_LINK(, [int i;], tcl_cv_ld_Bexport=yes, tcl_cv_ld_Bexport=no)
		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

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,
	AC_HELP_STRING([--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

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_*) ;;
	    CYGWIN_*|MINGW32_*|MSYS_*) ;;
	    HP_UX*) ;;
	    Darwin-*) ;;
	    IRIX*) ;;
	    Linux*|GNU*) ;;
	    NetBSD-*|OpenBSD-*) ;;
	    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

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.
    # 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([],
    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
		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

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_TRY_LINK([#include <sys/types.h>
#include <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)])
]])],[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

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_HAVE_HEADERS(sys/param.h)
    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

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_TRY_CPP([#include <X11/Xlib.h>], , not_really_there="yes")
	    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_TRY_CPP([#include <X11/Xlib.h>], found_xincludes="yes", 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

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_HEADER_TIME
    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_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
	    tcl_cv_member_tm_tzadj=yes, tcl_cv_member_tm_tzadj=no)])
	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_TRY_COMPILE([#include <time.h>], [struct tm tm; (void)tm.tm_gmtoff;],
	    tcl_cv_member_tm_gmtoff=yes, tcl_cv_member_tm_gmtoff=no)])
	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_TRY_COMPILE([#include <time.h>],
	    [extern long timezone;
	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)])
	    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;
	    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)])
		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.
#	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

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]])],
	AC_TRY_COMPILE([$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,
	    [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[[#define ]$1[ 1
	    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)))
]$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

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
#		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})])
        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
	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)])
	    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_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)])
	    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_TRY_COMPILE([#include <sys/stat.h>],[struct stat64 p;
],
		tcl_cv_struct_stat64=yes,tcl_cv_struct_stat64=no)])
	    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_TRY_COMPILE([#include <sys/types.h>],[off64_t offset;
],
		tcl_cv_type_off64_t=yes,tcl_cv_type_off64_t=no)])
	    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

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,
	AC_HELP_STRING([--with-encoding],
	AS_HELP_STRING([--with-encoding],
	    [encoding for configuration values (default: utf-8)]),
	with_tcencoding=${withval})
	[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

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_TRY_RUN([[
	    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))
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

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_TRY_COMPILE([
    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_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([
	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_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

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_TRY_COMPILE([
    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_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([
	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_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([
	    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_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

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_TRY_COMPILE([
    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_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([
	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_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

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_TRY_COMPILE([
    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_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([
	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_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

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_TRY_COMPILE([
    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_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([
	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_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

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_TRY_COMPILE([
    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_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([
	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_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

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
#       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

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

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@
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@




︙







Changes to unix/tcl.spec.



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








# 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
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

8
9
10
11
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.
 */

#undef BUILD_tcl
#undef STATIC_BUILD
#include "tcl.h"
#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7
#   define Tcl_LibraryInitProc Tcl_PackageInitProc
#   define Tcl_StaticLibrary Tcl_StaticPackage
#endif

#ifdef TCL_TEST
extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
extern Tcl_LibraryInitProc Tcltest_Init;
extern Tcl_LibraryInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */

#ifdef TCL_XT_TEST
extern void                XtToolkitInitialize(void);
extern Tcl_PackageInitProc Tclxttest_Init;
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

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);
#else
#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

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_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
    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

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_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_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

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

/* Do we have the intptr_t type? */
/* 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 <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. */




︙


200
201
202
203
204
205
206



207
208
209
210
211
212
213

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

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? */
/* 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

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 you have the ANSI C header files. */
/* 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

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

/* 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? */




︙


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

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 you are not using gcc.  */
/* 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

/* 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. */
/* 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

/* 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
    /* 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

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]>
 * 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

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. */
				 * 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

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		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.
 * Incorporate the base notifier implementation.
 */

#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 * 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.
 *	If no initNotifierProc notifier hook exists, PlatformEventsInit is
 *	called.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
TclpInitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	PlatformEventsInit();
	return tsdPtr;
    }
}
    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




︙


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

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.
 *
 *----------------------------------------------------------------------
 */

void
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 = (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
     * 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

240
241
242
243
244
245
246

247
248
249
250
251
252
253
254








-
+








	Tcl_Panic("epoll_ctl: %s", strerror(errno));
   }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsFinalize --
 * 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

262
263
264
265
266
267
268


269
270
271
272
273
274
275
276
277








-
-
+
+








 *
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsFinalize(
	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

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.
 *
 *----------------------------------------------------------------------
 */

void
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));
    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->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

379
380
381
382
383
384
385

386
387
388
389
390
391
392
393








-
+








 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
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

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.
 *
 *----------------------------------------------------------------------
 */

int
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

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;
	timeout = (int) timePtr->tv_sec * 1000;
	if (timePtr->tv_usec) {
	    timeout += (int)timePtr->tv_usec / 1000;
	    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);
    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 --
 * 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
Tcl_CreateFileHandler(
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. */
{
    int isNew;

    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	FileHandler *filePtr;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
    int isNew = (filePtr == NULL);
	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;
    if (isNew) {
	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;
    }
    filePtr->proc = proc;
    filePtr->clientData = clientData;
    filePtr->mask = mask;

	PlatformEventsControl(filePtr, tsdPtr,
		isNew ? EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew);
    }
}
    PlatformEventsControl(filePtr, tsdPtr,
	    isNew ? EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 * 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
Tcl_DeleteFileHandler(
TclpDeleteFileHandler(
    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);
    FileHandler *filePtr, *prevPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * Find the entry for the given file (and return if there isn't one).
	 */
    /*
     * 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;
    filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr);
    if (filePtr == NULL) {
	return;
	    }
	    if (filePtr->fd == fd) {
		break;
	    }
	}
    }

	/*
	 * Update the check masks for this file.
	 */
    /*
     * Update the check masks for this file.
     */

	PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0);
	if (filePtr->pedPtr) {
	    Tcl_Free(filePtr->pedPtr);
	}
    PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0);
    if (filePtr->pedPtr) {
	Tcl_Free(filePtr->pedPtr);
    }

	/*
	 * Clean up information in the callback record.
	 */
    /*
     * Clean up information in the callback record.
     */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    if (prevPtr == NULL) {
	tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
    } else {
	prevPtr->nextPtr = filePtr->nextPtr;
    }
    Tcl_Free(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 * 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
 *	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
Tcl_WaitForEvent(
TclpWaitForEvent(
    const Tcl_Time *timePtr)	/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
    FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
    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;
				/* 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;
    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
    /*
     * 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.
	 * 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 != 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;
	}
	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
    /*
     * 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().
	 * 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;
	    }
    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.
	     */
	/*
	 * 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));
	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;
	}
	    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 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;
	}
    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
    /*
     * 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.
	 * 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]);
    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,
	if (filePtr->fd == tsdPtr->triggerEventFd) {
	    uint64_t eventFdVal;

	    i = read(tsdPtr->triggerEventFd, &eventFdVal, sizeof(eventFdVal));
			sizeof(eventFdVal));
		if ((i != sizeof(eventFdVal)) && (errno != EAGAIN)) {
	    if ((i != sizeof(eventFdVal)) && (errno != EAGAIN)) {
		    Tcl_Panic(
			    "Tcl_WaitForEvent: read from %p->triggerEventFd: %s",
			    (void *) tsdPtr, strerror(errno));
		}
		continue;
	    }
		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)) {
	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;
	    }
		Tcl_Panic("%s: read from %p->triggerPipe[0]: %s",
			"Tcl_WaitForEvent", (void *) tsdPtr, strerror(errno));
	    }
	    continue;
	}
#endif /* HAVE_EVENTFD */
	    if (!mask) {
		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.
	     */
	/*
	 * 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));
	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;
    }
}
	    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

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]>
 * 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

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;
    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

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
				 * PlatformEventsFinalize. */
				 * 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 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.
 *
 *----------------------------------------------------------------------
 */

 * Incorporate the base notifier implementation.
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.
 *
 *----------------------------------------------------------------------
 */

#include "tclUnixNotfy.c"
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




︙


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

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.)
 *
 *----------------------------------------------------------------------
 */

void
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 = (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

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,
	    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,
	    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

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,
	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,
	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 --
 * 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

265
266
267
268
269
270
271


272
273
274
275
276
277
278
279
280








-
-
+
+








 *
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsFinalize(
    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

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));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsInit --
 * 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:
 *	None.
 *	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.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsInit(void)
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

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 = (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->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.
 *
 *----------------------------------------------------------------------
 */

int
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

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.
 *
 *----------------------------------------------------------------------
 */

int
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

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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 * 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
Tcl_CreateFileHandler(
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. */
{
    int isNew;

    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	FileHandler *filePtr;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
    int isNew = (filePtr == NULL);
	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;
    if (isNew) {
	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;
    }
    filePtr->proc = proc;
    filePtr->clientData = clientData;
    filePtr->mask = mask;

	PlatformEventsControl(filePtr, tsdPtr, EV_ADD, isNew);
    }
}
    PlatformEventsControl(filePtr, tsdPtr, EV_ADD, isNew);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 * 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
Tcl_DeleteFileHandler(
TclpDeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    if (tclNotifierHooks.deleteFileHandlerProc) {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	tclNotifierHooks.deleteFileHandlerProc(fd);
	return;
    } else {
	FileHandler *filePtr, *prevPtr;
    FileHandler *filePtr, *prevPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * Find the entry for the given file (and return if there isn't one).
	 */
    /*
     * 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;
    filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr);
    if (filePtr == NULL) {
	return;
	    }
	    if (filePtr->fd == fd) {
		break;
	    }
	}
    }

	/*
	 * Update the check masks for this file.
	 */
    /*
     * Update the check masks for this file.
     */

	PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0);
	if (filePtr->pedPtr) {
	    Tcl_Free(filePtr->pedPtr);
	}
    PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0);
    if (filePtr->pedPtr) {
	Tcl_Free(filePtr->pedPtr);
    }

	/*
	 * Clean up information in the callback record.
	 */
    /*
     * Clean up information in the callback record.
     */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    if (prevPtr == NULL) {
	tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
    } else {
	prevPtr->nextPtr = filePtr->nextPtr;
    }
    Tcl_Free(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 * 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
 *	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
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
TclpWaitForEvent(
    const Tcl_Time *timePtr)	/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
    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;
				/* 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];
    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
    /*
     * 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.
	 * 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 != 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;
	}
	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().
	 */
    /*
     * 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;
	    }
    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.
	     */
	/*
	 * 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));
	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;
	}
	    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 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;
	}
    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.
	 */
    /*
     * 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;
	    }
    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.
	     */
	/*
	 * 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));
	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;
    }
}
	    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

1
2
3
4
5
6
7
8
9
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
 *	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 (c) 1992 HELIOS Software GmbH
 * 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

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.
 * 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

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);
}

/*
 *----------------------------------------------------------------------
 *
 * 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:
 */








Changes to unix/tclLoadDyld.c.



1
2
3
4
5
6
7
8
9
10


11
12
13
14
15
16
17

1
2
3
4
5
6
7
8


9
10
11
12
13
14
15
16
17









-
-
+
+








/*
 * 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]>
 * 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

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;
    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_PackageInitProc *)dlsym(dyldLoadHandle->dlHandle, native);
	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

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);
	    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

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);
}

/*
 *----------------------------------------------------------------------
 *
 * 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.




︙







Changes to unix/tclLoadNext.c.



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








/*
 * 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.
 * 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

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;
    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

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);
}

/*
 *----------------------------------------------------------------------
 *
 * 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:
 */








Changes to unix/tclLoadOSF.c.




︙


22
23
24
25
26
27
28
29

30
31
32
33
34
35
36

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.
 * 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

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);
    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_PackageInitProc *) load(native, LDR_NOFLAGS);
	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

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);
}

/*
 *----------------------------------------------------------------------
 *
 * 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:
 */








Changes to unix/tclLoadShl.c.



1
2
3
4
5
6
7
8

9
10
11
12
13
14
15

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15








-
+








/*
 * 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.
 * 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

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;
    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

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);
}

/*
 *----------------------------------------------------------------------
 *
 * 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:
 */








Changes to unix/tclSelectNotfy.c.



1
2
3
4
5
6
7
8

9
10
11
12
13
14
15

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15








-
+








/*
 * 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.
 * 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

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. */
    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

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 *);
			    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

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"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 * TclpInitNotifier --
 *
 *	Initializes the platform specific notifier state.
 *
 * Results:
 *	Returns a handle to the notifier state for this thread.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
TclpInitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if TCL_THREADS
	tsdPtr->eventReady = 0;
    tsdPtr->eventReady = 0;

	/*
	 * Initialize thread specific condition variable for this thread.
	 */
	if (tsdPtr->waitCVinitialized == 0) {
    /*
     * Initialize thread specific condition variable for this thread.
     */

    if (tsdPtr->waitCVinitialized == 0) {
#ifdef __CYGWIN__
	    WNDCLASSW clazz;
	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;
	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);
	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;
	}
	tsdPtr->waitCVinitialized = 1;
    }

	pthread_mutex_lock(&notifierInitMutex);
    pthread_mutex_lock(&notifierInitMutex);
#if defined(HAVE_PTHREAD_ATFORK)
	/*
	 * Install pthread_atfork handlers to clean up the notifier in the
	 * child of a fork.
	 */
    /*
     * 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 (!atForkInit) {
	int result = pthread_atfork(NULL, NULL, AtForkChild);

	    if (result) {
		Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
	    }
	    atForkInit = 1;
	}
	if (result) {
	    Tcl_Panic("Tcl_InitNotifier: %s", "pthread_atfork failed");
	}
	atForkInit = 1;
    }
#endif /* HAVE_PTHREAD_ATFORK */

	notifierCount++;
	pthread_mutex_unlock(&notifierInitMutex);
    notifierCount++;
    pthread_mutex_unlock(&notifierInitMutex);

#endif /* TCL_THREADS */
	return tsdPtr;
    }

    return tsdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 * 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
Tcl_FinalizeNotifier(
    ClientData clientData)
TclpFinalizeNotifier(
    TCL_UNUSED(void *))
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	pthread_mutex_lock(&notifierInitMutex);
	notifierCount--;
    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 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 (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;
	    }
	}
	    if (result) {
		Tcl_Panic("Tcl_FinalizeNotifier: %s",
			"unable to join notifier thread");
	    }
	    notifierThreadRunning = 0;
	}
    }

	/*
	 * Clean up any synchronization objects in the thread local storage.
	 */
    /*
     * 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);
    DestroyWindow(tsdPtr->hwnd);
    CloseHandle(tsdPtr->event);
#else /* !__CYGWIN__ */
    pthread_cond_destroy(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
	tsdPtr->waitCVinitialized = 0;
    tsdPtr->waitCVinitialized = 0;

	pthread_mutex_unlock(&notifierInitMutex);
    pthread_mutex_unlock(&notifierInitMutex);
#endif /* TCL_THREADS */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 * TclpCreateFileHandler --
 *
 *	This function registers a file handler with the select notifier.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateFileHandler(
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. */
{
    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	FileHandler *filePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);

	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;
    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.
	 */
    /*
     * 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;
    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 --
 * 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
Tcl_DeleteFileHandler(
TclpDeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    if (tclNotifierHooks.deleteFileHandlerProc) {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	tclNotifierHooks.deleteFileHandlerProc(fd);
	return;
    } else {
	FileHandler *filePtr, *prevPtr;
	int i;
    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).
	 */
    /*
     * 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;
    filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr);
    if (filePtr == NULL) {
	return;
	    }
	    if (filePtr->fd == fd) {
		break;
	    }
	}
    }

	/*
	 * Update the check masks for this file.
	 */
    /*
     * 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);
	}
    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.
	 */
    /*
     * Find current max fd.
     */

	if (fd+1 == tsdPtr->numFdBits) {
	    int numFdBits = 0;
    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;
	}
	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.
	 */
    /*
     * Clean up information in the callback record.
     */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    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

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__ */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 * 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
Tcl_WaitForEvent(
TclpWaitForEvent(
    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);
    FileHandler *filePtr;
    int mask;
    Tcl_Time vTime;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
#if TCL_THREADS
	int waitForFiles;
    int waitForFiles;
#   ifdef __CYGWIN__
	MSG msg;
    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.
	 */
    /*
     * 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;
    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
    /*
     * 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.
	 * 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 != 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 (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.
	     */
	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;
	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");
    /*
     * 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);
    pthread_mutex_lock(&notifierMutex);

	if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
    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
	    /*
	     * 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.
	     */
	    )) {
	/*
	 * 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;
	}
	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.
	     */
    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;
	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");
	    }
	}
	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);
    FD_ZERO(&tsdPtr->readyMasks.readable);
    FD_ZERO(&tsdPtr->readyMasks.writable);
    FD_ZERO(&tsdPtr->readyMasks.exception);

	if (!tsdPtr->eventReady) {
    if (!tsdPtr->eventReady) {
#ifdef __CYGWIN__
	    if (!PeekMessageW(&msg, NULL, 0, 0, 0)) {
		unsigned int timeout;
	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);
	    }
	    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;
	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);
	    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);
	    }
	    pthread_cond_timedwait(&tsdPtr->waitCV, &notifierMutex, &ptime);
	} else {
	    pthread_cond_wait(&tsdPtr->waitCV, &notifierMutex);
	}
#endif /* __CYGWIN__ */
	}
	tsdPtr->eventReady = 0;
    }
    tsdPtr->eventReady = 0;

#ifdef __CYGWIN__
	while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
	    /*
	     * Retrieve and dispatch the message.
	     */
    while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
	/*
	 * Retrieve and dispatch the message.
	 */

	    unsigned int result = GetMessageW(&msg, NULL, 0, 0);
	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);
	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 (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");
	    }
	}
	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);
    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.
	 */
    /*
     * 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);
	}
    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.
	 */
    /*
     * 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;
	    }
    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;
	    }
	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.
	     */
	/*
	 * 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));
	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;
	}
	    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);
    pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
	return 0;
    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.
 *	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

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) {
	    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

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

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.
 * 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

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);
			    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

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);
    if (bytesRead >= 0) {
	return bytesRead;
	bytesRead = read(fsPtr->fd, buf, toRead);
    } while ((bytesRead < 0) && (errno == EINTR));

    if (bytesRead < 0) {
	*errorCodePtr = errno;
	return -1;
    }
    *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

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 Tcl_WideInt
static long long
FileWideSeekProc(
    void *instanceData,	/* File state. */
    Tcl_WideInt offset,		/* Offset to seek to. */
    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;
    Tcl_WideInt newLoc;
    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

1972
1973
1974
1975
1976
1977
1978

1979
1980
1981
1982
1983
1984
1985
1986








-
+








 *
 *----------------------------------------------------------------------
 */

static int
FileTruncateProc(
    void *instanceData,
    Tcl_WideInt length)
    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

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;
    int local_errno;

    return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
			   sizeof(tsdPtr->hbuf), &h_errno);
			   sizeof(tsdPtr->hbuf), &local_errno);

#elif defined(HAVE_GETHOSTBYNAME_R_6)
    struct hostent *hePtr = NULL;
    int h_errno, result;
    int local_errno, result;

    result = gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
	    sizeof(tsdPtr->hbuf), &hePtr, &h_errno);
	    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

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;
    int local_errno;

    return gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
	    sizeof(tsdPtr->hbuf), &h_errno);
	    sizeof(tsdPtr->hbuf), &local_errno);

#elif defined(HAVE_GETHOSTBYADDR_R_8)
    struct hostent *hePtr;
    int h_errno;
    int local_errno;

    return (gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
		sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0)
		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

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

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.
 * 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

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)) {
	    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
	    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

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.
 * 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 (c) 1988, 1993, 1994
 * 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

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);
	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

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);
	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

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);
    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

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);
	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 = TclGetStringFromObj(basenameObj, &length);
	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 = TclGetStringFromObj(extensionObj, &length);
	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

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_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

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.
 * 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

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);
    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

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_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

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);
    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

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.
 * 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

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
#define NUMPROCESSORS 15
static const char *const processors[NUMPROCESSORS] = {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
    "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

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);
    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

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",
    Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
	    "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

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.
 *	implementations on *nix platforms. It is *included* by the epoll,
 *	kqueue and select notifier implementation files.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <[email protected]>
 * 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

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)
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 --
 * 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

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
Tcl_AlertNotifier(
TclpAlertNotifier(
    ClientData clientData)
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

	pthread_mutex_lock(&notifierMutex);
	tsdPtr->eventReady = 1;
    pthread_mutex_lock(&notifierMutex);
    tsdPtr->eventReady = 1;

#   ifdef __CYGWIN__
	PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
    PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#   else
	pthread_cond_broadcast(&tsdPtr->waitCV);
    pthread_cond_broadcast(&tsdPtr->waitCV);
#   endif /* __CYGWIN__ */
	pthread_mutex_unlock(&notifierMutex);
    pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
#else /* !NOTIFIER_SELECT */
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;
    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);
	}
    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);
	}
    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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimer --
 * 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
Tcl_SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
TclpSetTimer(
    TCL_UNUSED(const Tcl_Time *))		/* 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.
	 */
    /*
     * 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(
TclpServiceModeHook(
    int mode)			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    } else if (mode == TCL_SERVICE_ALL) {
    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

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 */
#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.




︙


438
439
440
441
442
443
444



445
446
447
448
449
450
451

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

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

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.
 * 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

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

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 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
#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>




︙







Changes to unix/tclUnixSock.c.



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5

6
7
8
9
10
11
12
13






-
+








/*
 * tclUnixSock.c --
 *
 *	This file contains Unix-specific socket related code.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * 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

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.
 * 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

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
 * 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

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.
 * 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

27
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.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
unsigned long long
TclpGetSeconds(void)
{
    return time(NULL);
    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.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
long long
TclpGetMicroseconds(void)
{
    Tcl_Time time;

    tclGetTimeProcPtr(&time, tclTimeClientData);
    return ((Tcl_WideInt)time.sec)*1000000 + time.usec;
    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

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.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
unsigned long long
TclpGetClicks(void)
{
	Tcl_WideUInt now;
    unsigned long long now;

#ifdef NO_GETTOD
    if (tclGetTimeProcPtr != NativeGetTime) {
    if (!IsTimeNative()) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);
	now = (Tcl_WideUInt)time.sec*1000000 + time.usec;
	GetTime(&time);
	now = ((unsigned long long)(unsigned long) time.sec)*1000000 +
	        time.usec;
    } else {
	/*
	 * A semi-NativeGetTime, specialized to clicks.
	 */
	struct tms dummy;

	now = (Tcl_WideUInt) times(&dummy);
	now = (unsigned long long) times(&dummy);
    }
#else
#else /* !NO_GETTOD */
    Tcl_Time time;

    tclGetTimeProcPtr(&time, tclTimeClientData);
    now = (Tcl_WideUInt)time.sec*1000000 + time.usec;
#endif
    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

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.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
long long
TclpGetWideClicks(void)
{
    Tcl_WideInt now;
    long long now;

    if (tclGetTimeProcPtr != NativeGetTime) {
    if (!IsTimeNative()) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);
	now = ((Tcl_WideInt)time.sec)*1000000 + time.usec;
	GetTime(&time);
	now = ((long long) time.sec)*1000000 + time.usec;
    } else {
#ifdef MAC_OSX_TCL
	now = (Tcl_WideInt) (mach_absolute_time() & INT64_MAX);
	now = (long long) (mach_absolute_time() & INT64_MAX);
#else
#error Wide high-resolution clicks not implemented on this platform
#endif
#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

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(
    Tcl_WideInt clicks)
    long long clicks)
{
    double nsec;

    if (tclGetTimeProcPtr != NativeGetTime) {
    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
#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

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 (tclGetTimeProcPtr != NativeGetTime) {
    if (!IsTimeNative()) {
	return 1.0;
    } else {
#ifdef MAC_OSX_TCL
	static int initialized = 0;
	static double scale = 0.0;

	if (initialized) {
	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;
	    scale = ((double) tb.numer) / tb.denom / 1000;
	    initialized = 1;
	    return scale;
	}
	return scale;
#else
#error Wide high-resolution clicks not implemented on this platform
#endif
#endif /* MAC_OSX_TCL */
    }
}
#endif /* TCL_WIDE_CLICKS */

/*
 *----------------------------------------------------------------------
 *




︙


283
284
285
286
287
288
289
290

291
292
293
294
295
296
297

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. */
{
    tclGetTimeProcPtr(timePtr, tclTimeClientData);
    GetTime(timePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimeProc --
 *




︙







Changes to unix/tclXtNotify.c.



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








/*
 * tclXtNotify.c --
 *
 *	This file contains the notifier driver implementation for the Xt
 *	intrinsics.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 * 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

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");
	    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

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 = (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

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;
    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

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 = (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

1
2
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.
 * 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_PackageInitProc Tclxttest_Init;
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

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		= tcldde$(DDEVER)${DLLSUFFIX}
DDE_DLL_FILE		= tcl9dde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE		= tclreg$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclreg$(REGVER)${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.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];\
			  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)
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@




︙


411
412
413
414
415
416
417

418
419
420
421
422
423
424

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

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

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)"
	@( \
	  $(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; \
	  $(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)
$(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}
${TCL_STUB_LIB_FILE}: ${STUB_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@$(RM) ${TCL_STUB_LIB_FILE}
	@MAKE_STUB_LIB@ ${STUB_OBJS}
	@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} ${DDE_OBJS} ${REG_OBJS}
${TCL_LIB_FILE}: ${TCL_OBJS}
	@$(RM) ${TCL_LIB_FILE}
	@MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@POST_MAKE_LIB@

${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
${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

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 \
	-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




︙


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

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)\"" \
		-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 @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) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
	$(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME)

tclOOStubLib.${OBJEXT}: tclOOStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
	$(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

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} reg${REGDOTVER}; \
	@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

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)/reg${REGDOTVER}"; \
	    $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
		"$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \
	    $(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)/reg${REGDOTVER}"; \
	    $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${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"; \




︙


880
881
882
883
884
885
886
887
888
889
890




891
892
893
894
895
896
897

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.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 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

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 *.rtf man2tcl.exe
	$(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
	$(RM) *.pch *.ilk *.pdb *.zip
	$(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
		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

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: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile
.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

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
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

1
2

3
4
5

6
7
8
9
10
11
12
13
14
15
16
17

18
19
20
21
22
23
24
25

26
27
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.69.
# Generated by GNU Autoconf 2.70 for tcl 9.0.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
# 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 -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
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
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
# 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 --'
IFS=" ""	$as_nl"

elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
PS1='$ '
PS2='> '
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
PS4='+ '
      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

# Ensure predictable behavior from utilities with locale-dependent output.
LC_ALL=C
export LC_ALL
    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
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 test "${PATH_SEPARATOR+set}" != set; then
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


# 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
  case $as_dir in #(((
  test -z "$as_dir" && as_dir=.
    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
    '') 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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  printf "%s\n" "$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




︙


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

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'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
as_fn_exit 255
printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
  fi
  # We don't want this to propagate to other subprocesses.
          { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; 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
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 :
if ( set x; as_fn_ret_success y && test x = \"\$1\" )
then :

else
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 :
  if (eval "$as_required") 2>/dev/null
then :
  as_have_required=yes
else
else $as_nop
  as_have_required=no
fi
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null
then :

else
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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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
	     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 :
		    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_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
		   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
$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 :
  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
IFS=$as_save_IFS
fi


      if test "x$CONFIG_SHELL" != x; then :
      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
printf "%s\n" "$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."
    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
    $as_echo "$0: Please tell [email protected] about your system,
    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

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=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *\'*) 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 ||
$as_echo X"$as_dir" |
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

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 :
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
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 :
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null
then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else
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
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  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

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 ||
$as_echo X/"$0" |
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

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" ||
    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
    { 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

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=
PACKAGE_TARNAME=
PACKAGE_VERSION=
PACKAGE_STRING=
PACKAGE_BUGREPORT=
PACKAGE_URL=
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 <stdio.h>
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
#include <stddef.h>
#ifdef HAVE_STDIO_H
# include <stdio.h>
#endif
#ifdef HAVE_SYS_STAT_H
#ifdef HAVE_STDLIB_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_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

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
EGREP
GREP
CPP
OBJEXT
EXEEXT
ac_ct_CC
CPPFLAGS
LDFLAGS
CFLAGS
CC




︙


751
752
753
754
755
756
757

758
759
760
761
762
763
764

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

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}'
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

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

  # 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=*)




︙


899
900
901
902
903
904
905
906

907
908

909
910
911
912
913
914
915

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"
      as_fn_error $? "invalid feature name: \`$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    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

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"
      as_fn_error $? "invalid feature name: \`$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    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

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

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"
      as_fn_error $? "invalid package name: \`$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    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"
      as_fn_error $? "invalid package name: \`$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    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

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.
    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
    printf "%s\n" "$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
      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" ;;
    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
    *)     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
		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

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 ||
$as_echo X"$as_myself" |
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

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 this package to adapt to many kinds of systems.
\`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

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/PACKAGE]
  --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

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=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  ac_dir_suffix=/`printf "%s\n" "$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|/||'`
  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

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 guested configure.
    # 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
      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
      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
configure
generated by GNU Autoconf 2.69
tcl configure 9.0
generated by GNU Autoconf 2.70

Copyright (C) 2012 Free Software Foundation, Inc.
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
  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\""
$as_echo "$ac_try_echo"; } >&5
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
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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 :
       } && test -s conftest.$ac_objext
then :
  ac_retval=0
else
  $as_echo "$as_me: failed program was:" >&5
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\""
$as_echo "$ac_try_echo"; } >&5
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
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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 :
then :
  ac_retval=0
else
  $as_echo "$as_me: failed program was:" >&5
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=
# 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
for ac_arg
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
do
  case $ac_arg in
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_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
# 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
  esac
  # 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; }

  as_fn_append ac_configure_args_raw " '$ac_arg'"
# 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; }

done
# 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

case $ac_configure_args_raw in
# 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
  *$as_nl*)
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
    ac_safe_unquote= ;;
	       { $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_unsafe_z='|&;<>()$`\\"*?[ ''	' # This string ends in space, tab.
# 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 ()
    ac_unsafe_a="$ac_unsafe_z#~"
{
  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
    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
  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
It was created by tcl $as_me 9.0, which was
generated by GNU Autoconf 2.70.  Invocation command line was

  $ $0 $@
  $ $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

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 #(((
  test -z "$as_dir" && as_dir=.
    $as_echo "PATH: $as_dir"
    '') 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

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=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
      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

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

    $as_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_*) { $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;} ;;
      *_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

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

    $as_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=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      esac
      $as_echo "$ac_var='\''$ac_val'\''"
      printf "%s\n" "$ac_var='\''$ac_val'\''"
    done | sort
    echo

    if test -n "$ac_subst_files"; then
      $as_echo "## ------------------- ##
      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=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	*\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	esac
	$as_echo "$ac_var='\''$ac_val'\''"
	printf "%s\n" "$ac_var='\''$ac_val'\''"
      done | sort
      echo
    fi

    if test -s confdefs.h; then
      $as_echo "## ----------- ##
      printf "%s\n" "## ----------- ##
## 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"
      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

$as_echo "/* confdefs.h */" > confdefs.h
printf "%s\n" "/* confdefs.h */" > confdefs.h

# Predefined preprocessor variables.

cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_URL "$PACKAGE_URL"
printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h
_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_files="$CONFIG_SITE"
    -*)  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_files="$prefix/share/config.site $prefix/etc/config.site"
  ac_site_file2=$prefix/etc/config.site
else
  ac_site_file1=$ac_default_prefix/share/config.site
  ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
  ac_site_file2=$ac_default_prefix/etc/config.site
fi

for ac_site_file in "$ac_site_file1" "$ac_site_file2"
for ac_site_file in $ac_site_files
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;}
  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" \
      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
      || { { 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
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
$as_echo "$as_me: loading cache $cache_file" >&6;}
    { 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
  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
$as_echo "$as_me: creating cache $cache_file" >&6;}
  { 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,)
      { $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;}
      { 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)
      { $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;}
      { 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
	  { $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;}
	  { 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
	  { $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;}
	  { 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
	{ $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;}
	{ 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=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
    *\'*) 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
  { $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
  { 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

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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
printf "%s\n" "$ac_ct_CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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:)
{ $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;}
{ 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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
  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
    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+' '}$@"
    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; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
printf "%s\n" "$ac_ct_CC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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:)
{ $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;}
{ 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" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
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.
$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
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; do
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\""
$as_echo "$ac_try_echo"; } >&5
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
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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 ()
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.
{ $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[^ ]*//'`
{ 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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$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 :
  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+set}" = set && test "$ac_cv_exeext" != no;
	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
else $as_nop
  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
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

{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
{ { 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_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else $as_nop
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "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; }
{ 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
$as_echo_n "checking for suffix of executables... " >&6; }
{ 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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$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 :
  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_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
$as_echo "$ac_cv_exeext" >&6; }
{ 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 ()
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.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
$as_echo_n "checking whether we are cross compiling... " >&6; }
{ 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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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
	{ { $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.
	{ { 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
$as_echo "$cross_compiling" >&6; }
{ 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
{ $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
{ 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 ()
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\""
$as_echo "$ac_try_echo"; } >&5
printf "%s\n" "$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 :
  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_echo "$as_me: failed program was:" >&5
else $as_nop
  printf "%s\n" "$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;}
{ { 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
$as_echo "$ac_cv_objext" >&6; }
{ 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
{ $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
{ 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 ()
main (void)
{
#ifndef __GNUC__
       choke me
#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_compiler_gnu=yes
else
else $as_nop
  ac_compiler_gnu=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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+set}
ac_test_CFLAGS=${CFLAGS+y}
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
{ 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_prog_cc_g=yes
else
else $as_nop
  CFLAGS=""
      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :

else
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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
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
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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
{ 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
{ $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
{ 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.  */
#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;
}

$ac_c_conftest_c89_program
/* 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 :
  if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_prog_cc_c89=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext
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)
    { $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; } ;;
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 :
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


{ $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
{ 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 () {return 0; }
$ac_kw foo_t foo () {return 0; }
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 :
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
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
$as_echo "$AR" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
printf "%s\n" "$AR" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
$as_echo "$ac_ct_AR" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
printf "%s\n" "$ac_ct_AR" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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:)
{ $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;}
{ 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
$as_echo "$RANLIB" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
printf "%s\n" "$RANLIB" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
$as_echo "$ac_ct_RANLIB" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
printf "%s\n" "$ac_ct_RANLIB" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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:)
{ $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;}
{ 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RC" >&5
$as_echo "$RC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RC" >&5
printf "%s\n" "$RC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5
$as_echo "$ac_ct_RC" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5
printf "%s\n" "$ac_ct_RC" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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:)
{ $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;}
{ 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.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
{ 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=`$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
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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
  SET_MAKE=
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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+set}" = set; then :
if test ${with_encoding+y}
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}"
	printf "%s\n" "#define TCL_CFGVAL_ENCODING \"${with_tcencoding}\"" >>confdefs.h
_ACEOF

    else
	$as_echo "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h
	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.
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
$as_echo_n "checking how to build libraries... " >&6; }
    { 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+set}" = set; then :
if test ${enable_shared+y}
then :
  enableval=$enable_shared; tcl_ok=$enableval
else
else $as_nop
  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; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared" >&5
printf "%s\n" "shared" >&6; }
	SHARED_BUILD=1
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
$as_echo "static" >&6; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: static" >&5
printf "%s\n" "static" >&6; }
	SHARED_BUILD=0

$as_echo "#define STATIC_BUILD 1" >>confdefs.h
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.
#--------------------------------------------------------------------

# 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 \
ac_header= ac_cache=
		  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
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






fi


if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes
done
then :

printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h

fi


    # 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; }
    { 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+set}" = set; then :
if test ${enable_64bit+y}
then :
  enableval=$enable_64bit; do64bit=$enableval
else
else $as_nop
  do64bit=no
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5
$as_echo "$do64bit" >&6; }
    { 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=""

$as_echo "#define MODULE_SCOPE extern" >>confdefs.h
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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5
$as_echo "$CYGPATH" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5
printf "%s\n" "$CYGPATH" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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
{ $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
{ 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 #(((
  test -z "$as_dir" && as_dir=.
    '') 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 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
    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
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5
$as_echo "$WINE" >&6; }
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5
printf "%s\n" "$WINE" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  { 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

      { $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
      { 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_cross=no
else
else $as_nop
  ac_cv_cross=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5
$as_echo "$ac_cv_cross" >&6; }
{ 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

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

	{ $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; }
	{ 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=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  printf "%s\n" "$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; }
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
	    { 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"
	{ $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
	{ 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_win32=no
else
else $as_nop
  ac_cv_win32=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5
$as_echo "$ac_cv_win32" >&6; }
{ 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"
	{ $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
	{ 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$ac_exeext
  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\""
$as_echo "$ac_try_echo"; } >&5
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
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  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 :
then :
  ac_retval=0
else
  $as_echo "$as_me: failed program was:" >&5
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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_municode=yes
else
else $as_nop
  ac_cv_municode=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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; }
{ 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
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

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking compiler flags" >&5
$as_echo_n "checking compiler flags... " >&6; }
    { 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
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
$as_echo "using static flags" >&6; }
            { 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
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
$as_echo "using shared flags" >&6; }
            { 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

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 -Wdeclaration-after-statement"
		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

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
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
		{ 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"
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
		{ 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_win_64bit=yes
else
else $as_nop
  tcl_win_64bit=no

fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
		    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
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
$as_echo "using static flags" >&6; }
            { 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
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
$as_echo "using shared flags" >&6; }
            { 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

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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
	    { 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

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
	$as_echo "#define TCL_CFG_DO64BIT 1" >>confdefs.h
	printf "%s\n" "#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 :
	{ 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
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
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 :
if ac_fn_c_try_run "$LINENO"
then :
  tcl_cv_seh=yes
else
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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5
$as_echo "$tcl_cv_seh" >&6; }
{ 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

$as_echo "#define HAVE_NO_SEH 1" >>confdefs.h
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.
	#
	{ $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
	{ 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 ()
main (void)
{

		EXCEPTION_DISPOSITION x;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_eh_disposition=yes
else
else $as_nop
  tcl_cv_eh_disposition=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5
$as_echo "$tcl_cv_eh_disposition" >&6; }
{ 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

$as_echo "#define EXCEPTION_DISPOSITION int" >>confdefs.h
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.

	{ $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
	{ 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 ()
main (void)
{

		CHAR c;
		SHORT s;
		LONG l;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_winnt_ignore_void=yes
else
else $as_nop
  tcl_cv_winnt_ignore_void=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h
printf "%s\n" "#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 :
	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 :

$as_echo "#define HAVE_STDBOOL_H 1" >>confdefs.h
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.

	{ $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
	{ 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 ()
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 :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_cast_to_union=yes
else
else $as_nop
  tcl_cv_cast_to_union=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam 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; }
{ 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

$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h
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

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 :
if test "${enable_shared+set}" = "set"
then :

  enableval="$enable_shared"
  tcl_ok=$enableval

else
else $as_nop

  tcl_ok=yes

fi
if test "$tcl_ok" = "yes"; then :
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
printf "%s\n" "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h

  if test "$do64bit" != "no"; then :
  if test "$do64bit" != "no"
then :


$as_echo "#define MP_64BIT 1" >>confdefs.h
printf "%s\n" "#define MP_64BIT 1" >>confdefs.h

    if test "$GCC" == "yes"; then :
    if test "$GCC" == "yes"
then :

      ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a

      TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a


else
else $as_nop

      ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib

      TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/tommath.lib


fi

else
else $as_nop

    ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib

    TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win32/tommath.lib


fi

else
else $as_nop

  ZLIB_OBJS=\${ZLIB_OBJS}

  TOMMATH_OBJS=\${TOMMATH_OBJS}


fi

$as_echo "#define HAVE_ZLIB 1" >>confdefs.h
printf "%s\n" "#define HAVE_ZLIB 1" >>confdefs.h


ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default"
ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "
if test "x$ac_cv_type_intptr_t" = xyes; then :

#include <stdint.h>

$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h

"
else

if test "x$ac_cv_type_intptr_t" = xyes
    { $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

then :
    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
printf "%s\n" "#define HAVE_INTPTR_T 1" >>confdefs.h
#define intptr_t $tcl_cv_intptr_t
_ACEOF

    fi

fi

fi
ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default"
ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "
if test "x$ac_cv_type_uintptr_t" = xyes; then :

#include <stdint.h>

$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h

"
else

if test "x$ac_cv_type_uintptr_t" = xyes
    { $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

then :
    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];

  ;
printf "%s\n" "#define HAVE_UINTPTR_T 1" >>confdefs.h

  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 :
if test ${enable_zipfs+y}
then :
  enableval=$enable_zipfs; tcl_ok=$enableval
else
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
    { $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
    { 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

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'
  { $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
  { 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
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
$as_echo "$bfd_cv_build_exeext" >&6; }
{ 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
    #

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
$as_echo_n "checking for tclsh... " >&6; }
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
printf %s "checking for tclsh... " >&6; }

    if ${ac_cv_path_tclsh+:} false; then :
  $as_echo_n "(cached) " >&6
else
    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"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
$as_echo "$TCLSH_PROG" >&6; }
	{ 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=""
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
$as_echo "No tclsh found on PATH" >&6; }
	{ 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=""

    { $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
    { 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"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
$as_echo "$ZIP_PROG" >&6; }
        { 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="*"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
$as_echo "Found INFO Zip in environment" >&6; }
        { 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}"
        { $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; }
        { 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
	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; }
{ 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;

$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h
printf "%s\n" "#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
printf "%s\n" "#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
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
    fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
{ 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.

{ $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
{ 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 ()
main (void)
{

  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_findex_enums=yes
else
else $as_nop
  tcl_cv_findex_enums=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
$as_echo "$tcl_cv_findex_enums" >&6; }
{ 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

$as_echo "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h
printf "%s\n" "#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
{ 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 ()
main (void)
{

  __cpuidex(0,0,0);

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_intrinsics=yes
else
else $as_nop
  tcl_cv_intrinsics=no
fi
rm -f core conftest.err conftest.$ac_objext \
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    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; }
{ 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

$as_echo "#define HAVE_INTRIN_H 1" >>confdefs.h
printf "%s\n" "#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
{ 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 ()
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_wspiapi_h=yes
else
else $as_nop
  tcl_cv_wspiapi_h=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_wspiapi_h" >&5
$as_echo "$tcl_cv_wspiapi_h" >&6; }
{ 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

$as_echo "#define HAVE_WSPIAPI_H 1" >>confdefs.h
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.

{ $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
{ 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 ()
main (void)
{

  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_findex_enums=yes
else
else $as_nop
  tcl_cv_findex_enums=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
$as_echo "$tcl_cv_findex_enums" >&6; }
{ 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

$as_echo "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h
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.
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5
$as_echo_n "checking for build with symbols... " >&6; }
    { 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+set}" = set; then :
if test ${enable_symbols+y}
then :
  enableval=$enable_symbols; tcl_ok=$enableval
else
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)'

$as_echo "#define NDEBUG 1" >>confdefs.h
printf "%s\n" "#define NDEBUG 1" >>confdefs.h

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }

	$as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h
	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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5
$as_echo "yes (standard debugging)" >&6; }
	    { 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

$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h
printf "%s\n" "#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
printf "%s\n" "#define TCL_COMPILE_DEBUG 1" >>confdefs.h


$as_echo "#define TCL_COMPILE_STATS 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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5
$as_echo "enabled symbols mem compile debugging" >&6; }
	    { 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
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5
$as_echo "enabled $tcl_ok debugging" >&6; }
	    { 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"



    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5
$as_echo_n "checking whether to embed manifest... " >&6; }
    { 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+set}" = set; then :
if test ${enable_embedded_manifest+y}
then :
  enableval=$enable_embedded_manifest; embed_ok=$enableval
else
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 :
  $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*
rm -rf conftest*

    fi
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $result" >&5
$as_echo "$result" >&6; }
    { 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

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 ; then
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

5887
5888
5889
5890
5891
5892
5893

5894
5895
5896
5897
5898
5899
5900
5901








-
+















ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest"
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

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_*) { $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;} ;;
      *_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

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+set}" = set || &/
     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
      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
$as_echo "$as_me: updating cache $cache_file" >&6;}
      { 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
    { $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;}
    { 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

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=`$as_echo "$ac_i" | sed "$ac_script"`
  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"
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
{ 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

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 -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
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
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
# 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 --'
IFS=" ""	$as_nl"

elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
PS1='$ '
PS2='> '
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
PS4='+ '
      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

# Ensure predictable behavior from utilities with locale-dependent output.
LC_ALL=C
export LC_ALL
    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
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 test "${PATH_SEPARATOR+set}" != set; then
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


# 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
  case $as_dir in #(((
  test -z "$as_dir" && as_dir=.
    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
    '') 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
  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  printf "%s\n" "$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
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  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

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 :
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
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 :
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null
then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else
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

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 ||
$as_echo X/"$0" |
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

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

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=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *\'*) 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 ||
$as_echo X"$as_dir" |
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

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 $as_me, which was
generated by GNU Autoconf 2.69.  Invocation command line was
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

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="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_config='$ac_cs_config_escaped'
ac_cs_version="\\
config.status
configured by $0, generated by GNU Autoconf 2.69,
tcl config.status 9.0
configured by $0, generated by GNU Autoconf 2.70,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 Free Software Foundation, Inc.
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

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 )
    $as_echo "$ac_cs_version"; exit ;;
    printf "%s\n" "$ac_cs_version"; exit ;;
  --config | --confi | --conf | --con | --co | --c )
    $as_echo "$ac_cs_config"; exit ;;
    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=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
    *\'*) 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 )
    $as_echo "$ac_cs_usage"; exit ;;
    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

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
  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
  \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
  $as_echo "$ac_log"
  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" ;;
    "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
  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

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=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; 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 '`
	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
	  printf "%s\n" "$*" | 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;}
      { 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=`$as_echo "$configure_input" |
       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 ||
$as_echo X"$ac_file" |
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

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=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  ac_dir_suffix=/`printf "%s\n" "$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|/||'`
  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

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@*)
  { $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;}
  { 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

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"; } &&
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
  { 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
$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
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


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
  { $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;}
  { 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

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_INIT(../generic/tcl.h)
AC_PREREQ(2.69)
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

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.




︙


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

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_TYPE([intptr_t], [
AC_CHECK_TYPES([intptr_t, uintptr_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], [
#include <stdint.h>
    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],
    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
	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
    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

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_TRY_COMPILE([
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)
]])],
    [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([
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)
]])],
    [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([
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#include <wspiapi.h>
], [],
        tcl_cv_wspiapi_h=yes,
        tcl_cv_wspiapi_h=no)
]], [[]])],
    [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([
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)
]])],
    [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

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 ; then
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

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_OUTPUT(Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest)
AC_CONFIG_FILES([Makefile tclConfig.sh tclsh.exe.manifest])
AC_OUTPUT

dnl Local Variables:
dnl mode: autoconf;
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

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)
# 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

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=msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,unchecked,none
#	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).
#		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
#		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).
#		pbds      =  Produce separate debug symbol files.
#		profile   =  Adds profiling hooks.  Map file is assumed.
#		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), as well.
#			    dll.  The shell will be static (and large), and
#		staticpkg = Affects the static option only to switch
#			    tclshXX.exe to have the dde and reg extension linked
#			    have the dde and registry extensions linked inside.
#			    inside it.
#		symbols   =  Adds symbols for step debugging.
#		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

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

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\reg\pkgIndex.tcl registry >> 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)reg$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIBNAME	= $(PROJECT)9registry$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB	= $(OUT_DIR)\$(TCLREGLIBNAME)

TCLDDELIBNAME	= $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIBNAME	= $(PROJECT)9dde$(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 \




︙


371
372
373
374
375
376
377

378
379
380
381
382
383
384

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

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

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 pkgs
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 pkgs
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.3 [list load "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.5 [list load "$(TCLREGLIB:\=/)" registry]
		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

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

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

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 \
	    /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) \
	$(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip -Fo$@ $?
	-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="\"$(CFG_RUNTIME_DLLFILE:\=\\)\""     \
	/DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\""     \
	/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$@ $?
	$(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?


$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
	$(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
	$(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

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

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)
!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 !$(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)\"
	@$(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

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

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>

/*
 * 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 */




︙







Changes to win/rules-ext.vc.




︙


27
28
29
30
31
32
33
34

35
36
37
38
39
40
41

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]
!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

1
2
3
4
5
6
7
8

9
10
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
# 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 = 6
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

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

########################################################################
# 6. Parse the OPTS macro to work out the requested build configuration.
# 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 shell. 0 -> keep them as shared libraries
#           Does not impact shared Tcl builds.
#           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

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 $(STATIC_BUILD)
!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 $(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

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

################################################################
# 7. Parse the STATS macro to configure code instrumentation
# 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

985
986
987
988
989
990
991

992
993
994
995
996
997
998
999








-
+








!else
TCL_COMPILE_DEBUG   = 0
!endif

!endif

####################################################################
# 8. Parse the CHECKS macro to configure additional compiler checks
# 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

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

################################################################
# 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.,
#




︙


1083
1084
1085
1086
1087
1088
1089

1090

1091




1092

1093
1094
1095
1096
1097

1098
1099
1100
1101
1102
1103
1104

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
#
!if $(DOING_TCL)

# 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

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

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
TKLIBNAME	= $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)
TKSTUBLIBNAME	= tkstub$(TK_VERSION).lib
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)"
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
PRJLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
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

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
!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

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 /DUSE_TCLOO_STUBS
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

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 /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS)
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

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

# 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.




︙


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

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) $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
	    [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 $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
	    [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

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

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("$(OUT_DIR)\tcl.nmake")
TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake"
!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

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.
# 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

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 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 OPTS=threads MSVCDIR=IDE"
# 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

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
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

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

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.hpj.in
# 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

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],
	    AS_HELP_STRING([--with-tcl],
		[directory containing tcl configuration (tclConfig.sh)]),
	    with_tclconfig="${withval}")
	    [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

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],
	    AS_HELP_STRING([--with-tk],
		[directory containing tk configuration (tkConfig.sh)]),
	    with_tkconfig="${withval}")
	    [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

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
#		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




︙


284
285
286
287
288
289
290
291
292
293
294
295
296
297
298

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_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)




︙


354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375

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 "${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?])




︙


459
460
461
462
463
464
465

466
467
468
469
470
471
472

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

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_TRY_COMPILE([
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	    #ifndef _WIN32
		#error cross-compiler
	    #endif
	], [],
	ac_cv_cross=no,
	ac_cv_cross=yes)
	]], [[]])],
	[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

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_TRY_COMPILE([
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		#ifdef _WIN32
		    #error win32
		#endif
	    ], [],
	    ac_cv_win32=no,
	    ac_cv_win32=yes)
	    ]], [[]])],
	    [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([
	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)
	    [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

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 -Wdeclaration-after-statement"
		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

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_TRY_COMPILE([
		AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		    #ifndef _WIN64
			#error 32-bit
		    #endif
		], [],
			tcl_win_64bit=yes,
			tcl_win_64bit=no
		]], [[]])],
			[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])
		    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

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_TRY_RUN([
	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)
	]])],
	    [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([
	    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)
	    ]])],
		[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([
	    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)
	    ]])],
	    [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([],
	    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)
	    ]])],
	    [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

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,
	AC_HELP_STRING([--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

19
20
21
22
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_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
extern Tcl_LibraryInitProc Tcltest_Init;
extern Tcl_LibraryInitProc 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;
#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

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) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES
#if defined(STATIC_BUILD)
    if (Registry_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
    Tcl_StaticLibrary(interp, "Registry", Registry_Init, NULL);

    if (Dde_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
    Tcl_StaticLibrary(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);
    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

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_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

1
2
3
4
5
6


7
8
9
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 (c) 1995-1996 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * 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. */

/*
 * 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);





︙


181
182
183
184
185
186
187
188
189


190
191
192
193

194
195
196
197
198
199
200

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, so just in case
     * someone manages to get a runtime there, make sure they know that.
     * 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 NT is the only supported platform");
	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

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.
 * 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

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 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,
			    Tcl_WideInt length);
			    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

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());
	    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

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
static long long
FileWideSeekProc(
    ClientData instanceData,	/* File state. */
    Tcl_WideInt offset,		/* Offset to seek to. */
    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

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);
	    Tcl_WinConvertError(winError);
	    *errorCodePtr = errno;
	    return -1;
	}
    }
    return (((Tcl_WideInt)((unsigned)newPos))
	    | ((Tcl_WideInt)newPosHigh << 32));
    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

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. */
    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) {
	    TclWinConvertError(winError);
	    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) {
	    TclWinConvertError(winError);
	    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)) {
	TclWinConvertError(GetLastError());
	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

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());
    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

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());
	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

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());
	    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

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);
	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

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());
	    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

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.
 * 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

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());
	    Tcl_WinConvertError(GetLastError());
	    errorCode = errno;
	}
    }

    consolePtr->watchMask &= consolePtr->validMask;

    /*




︙


768
769
770
771
772
773
774
775

776
777
778
779
780
781
782

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);
	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

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());
	    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

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());
	    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

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());
	    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

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());
	    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

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());
		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

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());
	    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

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_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

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.
 * 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

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 --
 * Tcl_WinConvertError --
 *
 *	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. */
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

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");
	    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

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.
 * 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

275
276
277
278
279
280
281

282
283
284
285
286
287
288
289








-
+








#endif
#endif

    if (retval != -1) {
	return retval;
    }

    TclWinConvertError(GetLastError());
    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

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());
		    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

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());
		    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

665
666
667
668
669
670
671

672
673
674
675
676
677
678
679








-
+








#endif
#endif

    if (retval != -1) {
	return retval;
    }

    TclWinConvertError(GetLastError());
    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

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());
		Tcl_WinConvertError(GetLastError());
		SetFileAttributesW(nativeDst, dstAttr);
	    }
	}
    }
    return TCL_ERROR;
}





︙


762
763
764
765
766
767
768
769

770
771
772
773
774
775
776

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());
    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

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());
		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

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);
	Tcl_WinConvertError(error);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------




︙


1050
1051
1052
1053
1054
1055
1056
1057

1058
1059
1060
1061
1062
1063
1064

1050
1051
1052
1053
1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1064








-
+








	 */

	if (RemoveDirectoryW(nativePath) != FALSE) {
	    return TCL_OK;
	}
    }

    TclWinConvertError(GetLastError());
    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

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());
		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

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());
	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

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());
	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

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());
	    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

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_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

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);
	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

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);
	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

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);
	    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

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_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

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.
 * 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

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)
	((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

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());
	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

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.
	 */

	TclWinConvertError(GetLastError());
	Tcl_WinConvertError(GetLastError());
	return -1;
    }

    /*
     * Check the target.
     */

    attr = GetFileAttributesW(linkTargetPath);
    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * The target doesn't exist.
	 */

	TclWinConvertError(GetLastError());
	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;
	    }

	    TclWinConvertError(GetLastError());
	    Tcl_WinConvertError(GetLastError());
	} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
	    if (CreateSymbolicLinkW(linkSourcePath, linkTargetPath,
		    0x2 /* SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE */)) {
	    /*
	     * Can't symlink files.
	     */
		/*
		 * Success!
		 */

		return 0;
	    } else {
	    Tcl_SetErrno(ENOTDIR);
		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

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.
	 */

	TclWinConvertError(GetLastError());
	Tcl_WinConvertError(GetLastError());
	return NULL;
    }

    /*
     * Make sure source file does exist.
     */

    attr = GetFileAttributesW(linkSourcePath);
    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * The source doesn't exist.
	 */

	TclWinConvertError(GetLastError());
	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

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.
	     */

	    TclWinConvertError(GetLastError());
	    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

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.
	 */

	TclWinConvertError(GetLastError());
	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.
	 */

	TclWinConvertError(GetLastError());
	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

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.
	 */

	TclWinConvertError(GetLastError());
	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.
	 */

	TclWinConvertError(GetLastError());
	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.
	 */

	TclWinConvertError(GetLastError());
	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

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, MAX_PATH);
    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

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 = TclGetStringFromObj(norm, &length);
	    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

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 = TclGetStringFromObj(fileNamePtr, &dirLength);
	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

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;
	    }

	    TclWinConvertError(err);
	    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

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') {
	    } 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') {
	    } 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

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) {
	    TclWinConvertError(lasterror);
	    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

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!
	     */

	    TclWinConvertError((DWORD) error);
	    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

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:
	    TclWinConvertError(GetLastError());
	    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

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"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

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) {
	TclWinConvertError(GetLastError());
	Tcl_WinConvertError(GetLastError());
	return -1;
    }
    return 0;
}

/*
 *----------------------------------------------------------------------




︙


1943
1944
1945
1946
1947
1948
1949
1950

1951
1952
1953
1954
1955
1956
1957

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) {
	TclWinConvertError(GetLastError());
	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

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 = ((Tcl_WideInt) data.nFileSizeLow) |
		(((Tcl_WideInt) data.nFileSizeHigh) << 32);
	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

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) {
		TclWinConvertError(lasterror);
		Tcl_WinConvertError(lasterror);
		return -1;
		}
	    hFind = FindFirstFileW(nativePath, &ffd);
	    if (hFind == INVALID_HANDLE_VALUE) {
		TclWinConvertError(GetLastError());
		Tcl_WinConvertError(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_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

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 -
	    (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
	    (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

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) {
	TclWinConvertError(GetLastError());
	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

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 = TclGetStringFromObj(tmpPathPtr, &length);
	    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

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 = TclGetStringFromObj(useThisCwd, &cwdLen);
	const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen);
	char drive_cur = path[0];

	if (drive_cur >= 'a') {
	    drive_cur -= ('a' - 'A');
	}
	if (drive[0] == drive_cur) {
	    absolutePath = Tcl_DuplicateObj(useThisCwd);




︙


3057
3058
3059
3060
3061
3062
3063
3064

3065
3066
3067
3068
3069
3070
3071

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 = TclGetStringFromObj(validPathPtr, &len);
    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

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 + 1);
	    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

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)) {
	TclWinConvertError(GetLastError());
	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

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.
 * 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

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


/*
 * Windows version dependend functions
 */
TclWinProcs tclWinProcs;

/*
 * The following arrays contain the human readable strings for the
 * processor values.
 */

#define NUMPROCESSORS 11
#define NUMPROCESSORS 15
static const char *const processors[NUMPROCESSORS] = {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
    "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

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);
    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 --
 *




︙


219
220
221
222
223
224
225
226

227
228
229
230
231
232
233

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 = TclGetStringFromObj(pathPtr, &length);
    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

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, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
    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

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, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
    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

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

/*
 * 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);




︙







Changes to win/tclWinLoad.c.



1
2
3
4
5
6
7
8

9
10
11
12
13
14
15

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15








-
+








/*
 * 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.
 * 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

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_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

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);
}

/*
 *----------------------------------------------------------------------
 *
 * 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).




︙


403
404
405
406
407
408
409
410

411
412
413
414
415
416
417

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;
    }

    TclWinConvertError(lastError);
    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

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.
 * 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

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
Tcl_InitNotifier(void)
TclpInitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	TclpGlobalLock();
	if (!initialized) {
	    initialized = 1;
	    InitializeCriticalSection(&notifierMutex);
	}
	TclpGlobalUnlock();
    TclpGlobalLock();
    if (!initialized) {
	initialized = 1;
	InitializeCriticalSection(&notifierMutex);
    }
    TclpGlobalUnlock();

	/*
	 * Register Notifier window class if this is the first thread to use
	 * this module.
	 */
    /*
     * Register Notifier window class if this is the first thread to use this
     * module.
     */

	EnterCriticalSection(&notifierMutex);
	if (notifierCount == 0) {
	    WNDCLASSW clazz;
    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;
	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);
	if (!RegisterClassW(&clazz)) {
	    Tcl_Panic("Tcl_InitNotifier: %s",
		    "unable to register TclNotifier window class");
	}
    }
    notifierCount++;
    LeaveCriticalSection(&notifierMutex);

	tsdPtr->pending = 0;
	tsdPtr->timerActive = 0;
    tsdPtr->pending = 0;
    tsdPtr->timerActive = 0;

	InitializeCriticalSection(&tsdPtr->crit);
    InitializeCriticalSection(&tsdPtr->crit);

	tsdPtr->hwnd = NULL;
	tsdPtr->thread = GetCurrentThreadId();
	tsdPtr->event = CreateEventW(NULL, TRUE /* manual */,
		FALSE /* !signaled */, NULL);
    tsdPtr->hwnd = NULL;
    tsdPtr->thread = GetCurrentThreadId();
    tsdPtr->event = CreateEventW(NULL, TRUE /* manual */,
	    FALSE /* !signaled */, NULL);

	return tsdPtr;
    return tsdPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 * 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
Tcl_FinalizeNotifier(
TclpFinalizeNotifier(
    ClientData clientData)	/* Pointer to notifier data. */
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
    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.
	 */
    /*
     * 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;
	}
    if (tsdPtr == NULL) {
	return;
    }

	DeleteCriticalSection(&tsdPtr->crit);
	CloseHandle(tsdPtr->event);
    DeleteCriticalSection(&tsdPtr->crit);
    CloseHandle(tsdPtr->event);

	/*
	 * Clean up the timer and messaging window for this thread.
	 */
    /*
     * Clean up the timer and messaging window for this thread.
     */

	if (tsdPtr->hwnd) {
	    KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	    DestroyWindow(tsdPtr->hwnd);
	}
    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.
	 */
    /*
     * 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);
    }
}
    EnterCriticalSection(&notifierMutex);
    if (notifierCount) {
	notifierCount--;
	if (notifierCount == 0) {
	    UnregisterClassW(className, (HINSTANCE) TclWinGetTclInstance());
	}
    }
    LeaveCriticalSection(&notifierMutex);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 * 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
Tcl_AlertNotifier(
TclpAlertNotifier(
    ClientData clientData)	/* Pointer to thread data. */
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
    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.
	 */
    /*
     * 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.
	     */
    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);
	}
    }
}
	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 --
 * 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
Tcl_SetTimer(
TclpSetTimer(
    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;
    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.
	 */
    /*
     * 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 (!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.
	     */
    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 = timePtr->sec * 1000 + timePtr->usec / 1000;
	if (timeout == 0) {
	    timeout = 1;
	}
    }

    if (timeout != 0) {
	tsdPtr->timerActive = 1;
	SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, timeout, NULL);
		    timeout, NULL);
	} else {
	    tsdPtr->timerActive = 0;
	    KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
    } else {
	tsdPtr->timerActive = 0;
	KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
 * 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
Tcl_ServiceModeHook(
TclpServiceModeHook(
    int mode)			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    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
    /*
     * 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.
	 * 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);
    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.
	     */
	/*
	 * 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);
	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

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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 * 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
Tcl_WaitForEvent(
TclpWaitForEvent(
    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;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    MSG msg;
    DWORD timeout, result;
    int status;

	/*
	 * Compute the timeout in milliseconds.
	 */
    /*
     * Compute the timeout in milliseconds.
     */

	if (timePtr) {
	    /*
	     * TIP #233 (Virtualized Time). Convert virtual domain delay to
	     * real-time.
	     */
    if (timePtr) {
	/*
	 * TIP #233 (Virtualized Time). Convert virtual domain delay to
	 * real-time.
	 */

	    Tcl_Time myTime;
	Tcl_Time myTime;

	    myTime.sec  = timePtr->sec;
	    myTime.usec = timePtr->usec;
	myTime.sec  = timePtr->sec;
	myTime.usec = timePtr->usec;

	    if (myTime.sec != 0 || myTime.usec != 0) {
		tclScaleTimeProcPtr(&myTime, tclTimeClientData);
	    }
	if (myTime.sec != 0 || myTime.usec != 0) {
	    TclScaleTime(&myTime);
	}

	    timeout = myTime.sec * 1000 + myTime.usec / 1000;
	} else {
	    timeout = INFINITE;
	}
	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.
	 */
    /*
     * 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.
	     */
    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:
	do {
	    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;
	    }
	}
	} while (result == WAIT_IO_COMPLETION);

	if (result == WAIT_FAILED) {
	    status = -1;
	    goto end;
	}
    }

	/*
	 * Check to see if there are any messages to process.
	 */
    /*
     * Check to see if there are any messages to process.
     */

	if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) {
	    /*
	     * Retrieve and dispatch the first message.
	     */
    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.
		 */
	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.
		 */
	    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;
	}
	    status = -1;
	} else {
	    TranslateMessage(&msg);
	    DispatchMessageW(&msg);
	    status = 1;
	}
    } else {
	status = 0;
    }

      end:
	ResetEvent(tsdPtr->event);
	return status;
  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

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.
     */

    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
    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;

	tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
	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

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.
 * 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

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.
 * 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

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);
	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

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);
	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

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());
    Tcl_WinConvertError(GetLastError());
    CloseHandle(handle);
    DeleteFileW(name);
    return NULL;
}

/*
 *----------------------------------------------------------------------




︙


780
781
782
783
784
785
786
787

788
789
790
791
792
793
794

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());
    Tcl_WinConvertError(GetLastError());
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCloseFile --




︙


821
822
823
824
825
826
827
828

829
830
831
832
833
834
835

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_WinConvertError(GetLastError());
		Tcl_Free(filePtr);
		return -1;
	    }
	}
	break;

    default:




︙


1022
1023
1024
1025
1026
1027
1028
1029

1030
1031
1032
1033
1034
1035
1036

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_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

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_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) {
	TclWinConvertError(GetLastError());
	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

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_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

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_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

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_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

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());
    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

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);
	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

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());
	    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

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());
	    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

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);
	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

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());
    Tcl_WinConvertError(GetLastError());
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPipeThreadCreateTI --




︙


3571
3572
3573
3574
3575
3576
3577
3578
3579

3580
3581
3582
3583
3584
3585
3586
3587

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).
	     */

	    if (tclWinProcs.cancelSynchronousIo) {
		tclWinProcs.cancelSynchronousIo(hThread);
	    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

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
 * WINVER = 0x0601 means Windows 7 and above
 */

#ifndef WINVER
#   define WINVER 0x0501
#   define WINVER 0x0601
#endif
#ifndef _WIN32_WINNT
#   define _WIN32_WINNT 0x0501
#   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

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>
#   ifdef __BORLANDC__
#	include <utime.h>
#   else
#	include <sys/utime.h>
#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.
 */





︙


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

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
#   if defined(_MSC_VER) && (_MSC_VER < 1600)
#	define hypot _hypot
#   endif
#   define exception _exception
#   undef EDEADLOCK
#   if defined(_MSC_VER) && (_MSC_VER >= 1700)
#   if defined(_MSC_VER)
#	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)
#   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.




︙







Changes to win/tclWinReg.c.




︙


187
188
189
190
191
192
193
194

195
196
197
198
199
200
201

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);
    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

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.
 * 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

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());
	    Tcl_WinConvertError(GetLastError());
	    errorCode = errno;
	}
    }

    serialPtr->watchMask &= serialPtr->validMask;

    /*




︙


924
925
926
927
928
929
930
931

932
933
934
935
936
937
938

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());
	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

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);
	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

1065
1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078
1079








-
+








	    goto error;
	}
    }

    return (int) bytesWritten;

  writeError:
    TclWinConvertError(GetLastError());
    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

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_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

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_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) {
	TclWinConvertError(GetLastError());
	Tcl_WinConvertError(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_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

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_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

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_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

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_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

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.
 * 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

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);
	    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

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);
	    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

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());
		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

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());
	Tcl_WinConvertError((DWORD) WSAGetLastError());
	readError = Tcl_GetErrno();
    }
    if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) {
	TclWinConvertError((DWORD) WSAGetLastError());
	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

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());
	    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

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());
	    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

1374
1375
1376
1377
1378
1379
1380

1381
1382
1383
1384
1385
1386
1387
1388








-
+








		}

		/*
		 * Return error message.
		 */

		if (err) {
		    TclWinConvertError(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

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());
		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

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_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

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());
		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

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());
		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

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);
	    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

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);
		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

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());
	    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

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());
	    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

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());
	    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

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());
	    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

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.
 * 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

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());
	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

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
 * 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

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__)
#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

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__)
#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

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.
 * 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

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) */
    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

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
     */

    Tcl_WideUInt fileTimeSample[SAMPLES];
    unsigned long long fileTimeSample[SAMPLES];
				/* Last 64 samples of system time. */
    Tcl_WideInt perfCounterSample[SAMPLES];
    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) (Tcl_WideInt) 0,
    (LARGE_INTEGER) (long long) 0,
    (ULARGE_INTEGER) (DWORDLONG) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 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 */
    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		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 Tcl_WideInt	NativeGetMicroseconds(void);
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.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
unsigned long long
TclpGetSeconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;
    long long usecSincePosixEpoch;

    /*
    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
     * Try to use high resolution timer
     */

    if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
    ) {
	return usecSincePosixEpoch / 1000000;
    } else {
	Tcl_Time t;

	tclGetTimeProcPtr(&t, tclTimeClientData);	/* Tcl_GetTime inlined. */
	return t.sec;
	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

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.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
unsigned long long
TclpGetClicks(void)
{
    Tcl_WideInt usecSincePosixEpoch;
    long long usecSincePosixEpoch;

    /*
    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
     * Try to use high resolution timer.
     */

    if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
    ) {
	return (Tcl_WideUInt)usecSincePosixEpoch;
	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;
	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

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).
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
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 (Tcl_WideInt)curCounter.QuadPart;
	    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

301
302
303
304
305
306
307

308
309
310
311
312
313
314
315








-
+








 *----------------------------------------------------------------------
 */

double
TclpWideClickInMicrosec(void)
{
    if (!wideClick.initialized) {
    	(void)TclpGetWideClicks();	/* initialize */
    	(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

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.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
long long
TclpGetMicroseconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;
    long long usecSincePosixEpoch;

    /*
    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
     * 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.
	*/
	 * 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;
	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

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. */
{
    Tcl_WideInt usecSincePosixEpoch;
    long long usecSincePosixEpoch;

    /*
    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
     * Try to use high resolution timer.
     */

    if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
    ) {
	timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
	timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
    } else {
    	tclGetTimeProcPtr(timePtr, tclTimeClientData);
	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

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 Tcl_WideInt
static inline long long
NativeCalc100NsTicks(
    ULONGLONG fileTimeLastCall,
    LONGLONG perfCounterLastCall,
    LONGLONG curCounterFreq,
    LONGLONG curCounter
    LONGLONG curCounter)
) {
{
    return fileTimeLastCall +
	((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq);
	    ((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq);
}

static Tcl_WideInt
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;

	    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) {
	    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

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 */

				/* 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 */
	     * 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
		11 * curCounterFreq * timeInfo.calibrationInterv / 10) {
	) {
	    /* Calibrated file-time is saved from posix in 100-ns ticks */
	    /*
	     * Calibrated file-time is saved from posix in 100-ns ticks.
	     */

	    return NativeCalc100NsTicks(fileTimeLastCall,
		perfCounterLastCall, curCounterFreq, curCounter.QuadPart) / 10;
		    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

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))
{
    Tcl_WideInt usecSincePosixEpoch;
    long long usecSincePosixEpoch;

    /*
     * Try to use high resolution timer.
     */

    if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) {
    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.
	*/
	 * High resolution timer is not available. Just use ftime.
	 */

	struct _timeb t;

	_ftime(&t);
	timePtr->sec = (long)t.time;
	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

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 */
     * 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

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 */
    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
    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. */
    Tcl_WideInt driftFreq;	/* Frequency needed to drift virtual time into
    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)
     * 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 */
    	/*
	 * 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

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,
	    (Tcl_WideUInt) curFileTime.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);
	    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 */
	 * Jump to current system time, use curent estimated frequency.
	 */

    	vt0 = curFileTime.QuadPart;
    } else {
    	/*
    	/* calculate new frequency and estimate drift to the next second */
	 * 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
	 * 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;
	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;
     * 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;
    } 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)
	 * 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;
	long long nt0, nt1;

	QueryPerformanceCounter(&newPerfCounter);
	nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart,
		timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart,
		newPerfCounter.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) */
		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 */
	     * 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 */
		 * Larger jump resp. shift relative new file-time.
		 */

	    	vt0 = curFileTime.QuadPart;
	    }
	}
    }

    /*
    /* In lock commit new values to timeInfo (hold lock as short as possible) */
     * 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) */
     * 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 */
	 * 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

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(
    Tcl_WideUInt fileTime,	/* Current file time */
    Tcl_WideInt perfCounter,	/* Current performance counter */
    Tcl_WideInt perfFreq)	/* Target performance frequency */
    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) {

    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

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 Tcl_WideInt
static long long
AccumulateSample(
    Tcl_WideInt perfCounter,
    Tcl_WideUInt fileTime)
    long long perfCounter,
    unsigned long long fileTime)
{
    unsigned long long workFTSample;
    Tcl_WideUInt workFTSample;	/* File time sample being removed from or
				/* File time sample being removed from or
				 * added to the circular buffer. */
    Tcl_WideInt workPCSample;	/* Performance counter sample being removed
    long long workPCSample;	/* Performance counter sample being removed
				 * from or added to the circular buffer. */
    unsigned long long lastFTSample;
    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 */
				/* 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

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] = (Tcl_WideInt) fileTime;
	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

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}"/>
	    <!-- 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>




︙










This page was generated in about
1.1s by
Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19